EXAMEN MÓDULO 5 - 2023

Carga de Librerías:

rm(list = ls())

suppressPackageStartupMessages({
    library(tictoc)
    library(flextable)
    library(kableExtra)
    library(missRanger)
    library(doParallel)
    library(dplyr)
    library(dlookr)
    library(SmartEDA)
    library(ggplot2)
    library(corrgram)
    library(randomForest)
    library(caret)
    library(doParallel)
    library(fastDummies)
    library(patchwork)
    library(gbm)
    library(car)
    library(data.table)
    library(tidytable)
    library(tibble)
    library(DALEX)
    library(data.table)
    library(corrplot)
    library(janitor)
    library(inspectdf)
    library(MASS)
    library(ISLR)
    library(skimr)
    library(funModeling)# Útil para visualizaciones.
    library(inspectdf) # Visualizaciones y estadística descriptiva.
    library(DataExplorer) # Correlaciones, gráficas y tablas.
    library(PerformanceAnalytics) # Correlaciones, gráficas y tablas.
    library(corrplot) # Análisis de correlaciones.
    library(mice)
  # Para maquetar tablas y hacerlas más vistosas.
  
  library(flextable)
  library(kableExtra)   
  library(rmarkdown)
  
})

Variables de la base de datos

-Lng : coordenada de longitud utilizando el protocolo BD09 -Lat : coordenada de latitud utilizando el protocolo BD09 -DOM : días activos en el mercado. Más información en https://en.wikipedia.org/wiki/Days_on_market -seguidores : el número de personas que siguen la transacción. -cuadrados : número total de metros. -salón : número de habitaciones. -drawingRoom : número de salones. -cocina : número de cocinas. -cuarto de baño : número de baños. -floor : el número total de pisos en el edificio. -buildingType : (tower) torre (1), bungalow (2), (combination of plate and tower), combinación de lámina y torre (3), (plate) lámina (4) -renovaciónCondición : Otros (1), ásperas (2), sencillez (3), duras (4) -buildingStructure : desconocida (1), mixta (2), ladrillo y madera (3), ladrillo y cemento (4), acero (5) acero y hormigón (6). -ladderRatio : Describa las escaleras que tiene un residente en promedio. -ascensor : tiene ascensor (1) no tiene ascensor (0) -fiveYearsProperty : si el dueño tiene la propiedad por menos de 5 años (1) en caso contrario (0) -metro : si está cerca del metro (1) en caso contario (0) -precio : precio por metro cuadrado en yuanes. -totalPrice : precio total en millones de yuanes.

MAPA DE PEKÍN

library(ggplot2)
load(file = "C:\\Users\\soho_\\Desktop\\DATOS_2ºTRIMESTRE\\M5\\2023_M5_examen_enunciado\\beijing_map.RData",verbose = TRUE)
## Loading objects:
##   beijing
beijing

Lectura de Datos:

datos<-read.csv("C:\\Users\\soho_\\Desktop\\DATOS_2ºTRIMESTRE\\M5\\2023_M5_examen_enunciado\\mercado_beijing_2017.csv")

str(datos)
## 'data.frame':    7455 obs. of  19 variables:
##  $ Lng                : num  116 116 117 116 117 ...
##  $ Lat                : num  40.2 40.2 39.9 40.1 39.9 ...
##  $ DOM                : int  546 457 430 487 392 398 369 370 347 272 ...
##  $ followers          : int  6 4 3 52 222 207 73 26 114 81 ...
##  $ square             : num  77 147 143 282 112 ...
##  $ livingRoom         : int  2 3 1 5 3 2 3 4 3 1 ...
##  $ drawingRoom        : int  1 2 0 2 2 1 1 2 1 1 ...
##  $ kitchen            : int  1 1 0 1 1 1 1 1 1 1 ...
##  $ bathRoom           : int  1 2 0 3 1 1 1 2 1 1 ...
##  $ floor              : int  6 7 32 6 6 6 18 8 9 18 ...
##  $ buildingType       : int  4 4 1 4 4 NA 1 4 3 1 ...
##  $ renovationCondition: int  1 4 3 3 2 2 3 3 4 4 ...
##  $ buildingStructure  : int  2 2 6 2 2 1 6 6 6 6 ...
##  $ ladderRatio        : num  0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
##  $ elevator           : int  0 0 1 0 0 0 1 1 1 1 ...
##  $ fiveYearsProperty  : int  1 1 1 1 1 0 0 0 1 0 ...
##  $ subway             : int  0 0 1 0 1 1 0 1 1 0 ...
##  $ price              : int  22078 24507 32794 20579 29483 24649 63628 76198 61186 43279 ...
##  $ totalPrice         : num  170 360 470 580 330 200 649 1300 826 264 ...

RENOMBRAMOS LAS VARIABLES PARA UN MEJOR ENTENDIMIENTO

names(datos)<-c("Lng","Lat","DOM","seguidores","cuadrados","salon","drawingRoom","cocina","cuartodebaño","floor","buildingType","renovacionCondicion","buildingStrucuture", "ladderRatio","ascensor","fiveYearsProperty","metro","precio","totalPrice")
head(datos)
Lng Lat DOM seguidores cuadrados salon drawingRoom cocina cuartodebaño floor buildingType renovacionCondicion buildingStrucuture ladderRatio ascensor fiveYearsProperty metro precio totalPrice
116.2324 40.23553 546 6 77.00 2 1 1 1 6 4 1 2 0.333 0 1 0 22078 170
116.2495 40.22179 457 4 146.90 3 2 1 2 7 4 4 2 0.500 0 1 0 24507 360
116.5239 39.92328 430 3 143.32 1 0 0 0 32 1 3 6 0.500 1 1 1 32794 470
116.4300 40.06624 487 52 281.85 5 2 1 3 6 4 3 2 0.500 0 1 0 20579 580
116.5209 39.91885 392 222 111.93 3 2 1 1 6 4 2 2 0.500 0 1 1 29483 330
116.2258 39.80226 398 207 81.14 2 1 1 1 6 NA 2 1 0.250 0 0 1 24649 200
summary(datos)
##       Lng             Lat             DOM            seguidores    
##  Min.   :116.1   Min.   :39.63   Min.   :   1.00   Min.   :  0.00  
##  1st Qu.:116.3   1st Qu.:39.89   1st Qu.:   1.00   1st Qu.:  1.00  
##  Median :116.4   Median :39.93   Median :   1.00   Median :  5.00  
##  Mean   :116.4   Mean   :39.94   Mean   :  14.32   Mean   : 14.48  
##  3rd Qu.:116.5   3rd Qu.:39.99   3rd Qu.:   5.00   3rd Qu.: 17.00  
##  Max.   :116.7   Max.   :40.25   Max.   :1352.00   Max.   :580.00  
##                                                                    
##    cuadrados          salon        drawingRoom        cocina      
##  Min.   :  6.90   Min.   :0.000   Min.   :0.000   Min.   :0.0000  
##  1st Qu.: 56.77   1st Qu.:1.000   1st Qu.:1.000   1st Qu.:1.0000  
##  Median : 76.90   Median :2.000   Median :1.000   Median :1.0000  
##  Mean   : 85.39   Mean   :1.919   Mean   :1.111   Mean   :0.9862  
##  3rd Qu.:100.17   3rd Qu.:2.000   3rd Qu.:1.000   3rd Qu.:1.0000  
##  Max.   :922.70   Max.   :7.000   Max.   :3.000   Max.   :4.0000  
##                                                                   
##   cuartodebaño     floor        buildingType   renovacionCondicion
##  Min.   :0.0   Min.   : 1.00   Min.   :1.000   Min.   :1.000      
##  1st Qu.:1.0   1st Qu.: 6.00   1st Qu.:1.000   1st Qu.:1.000      
##  Median :1.0   Median :16.00   Median :3.000   Median :3.000      
##  Mean   :1.2   Mean   :15.88   Mean   :2.707   Mean   :2.849      
##  3rd Qu.:1.0   3rd Qu.:22.00   3rd Qu.:4.000   3rd Qu.:4.000      
##  Max.   :6.0   Max.   :42.00   Max.   :4.000   Max.   :4.000      
##                                NA's   :316                        
##  buildingStrucuture  ladderRatio         ascensor     fiveYearsProperty
##  Min.   :1.000      Min.   : 0.0200   Min.   :0.000   Min.   :0.0000   
##  1st Qu.:2.000      1st Qu.: 0.2500   1st Qu.:0.000   1st Qu.:0.0000   
##  Median :6.000      Median : 0.3330   Median :1.000   Median :1.0000   
##  Mean   :4.878      Mean   : 0.3604   Mean   :0.692   Mean   :0.5545   
##  3rd Qu.:6.000      3rd Qu.: 0.5000   3rd Qu.:1.000   3rd Qu.:1.0000   
##  Max.   :6.000      Max.   :10.0000   Max.   :1.000   Max.   :1.0000   
##                                                                        
##      metro            precio         totalPrice    
##  Min.   :0.0000   Min.   :     2   Min.   :   0.1  
##  1st Qu.:0.0000   1st Qu.: 28993   1st Qu.: 205.0  
##  Median :1.0000   Median : 39362   Median : 305.0  
##  Mean   :0.5958   Mean   : 44911   Mean   : 368.8  
##  3rd Qu.:1.0000   3rd Qu.: 55222   3rd Qu.: 445.0  
##  Max.   :1.0000   Max.   :156250   Max.   :4650.0  
## 
##VEMOS QUE MÁS DE UNA VARIABLE SE PUEDE PASAR A FACTOR PARA TRABAJAR CON SUS DATOS:


datos$buildingType = as.factor(datos$buildingType)
datos$buildingStrucuture = as.factor(datos$buildingStrucuture)
datos$floor = as.factor(datos$floor)
datos$ascensor = as.factor(datos$ascensor)
datos$fiveYearsProperty = as.factor(datos$fiveYearsProperty)
datos$metro  = as.factor(datos$metro)
datos$renovacionCondicion=as.factor(datos$renovacionCondicion)
##COMPROBAMOS LOS CAMBIOS:
str(datos)
## 'data.frame':    7455 obs. of  19 variables:
##  $ Lng                : num  116 116 117 116 117 ...
##  $ Lat                : num  40.2 40.2 39.9 40.1 39.9 ...
##  $ DOM                : int  546 457 430 487 392 398 369 370 347 272 ...
##  $ seguidores         : int  6 4 3 52 222 207 73 26 114 81 ...
##  $ cuadrados          : num  77 147 143 282 112 ...
##  $ salon              : int  2 3 1 5 3 2 3 4 3 1 ...
##  $ drawingRoom        : int  1 2 0 2 2 1 1 2 1 1 ...
##  $ cocina             : int  1 1 0 1 1 1 1 1 1 1 ...
##  $ cuartodebaño       : int  1 2 0 3 1 1 1 2 1 1 ...
##  $ floor              : Factor w/ 37 levels "1","2","3","4",..: 6 7 32 6 6 6 18 8 9 18 ...
##  $ buildingType       : Factor w/ 4 levels "1","2","3","4": 4 4 1 4 4 NA 1 4 3 1 ...
##  $ renovacionCondicion: Factor w/ 4 levels "1","2","3","4": 1 4 3 3 2 2 3 3 4 4 ...
##  $ buildingStrucuture : Factor w/ 6 levels "1","2","3","4",..: 2 2 6 2 2 1 6 6 6 6 ...
##  $ ladderRatio        : num  0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
##  $ ascensor           : Factor w/ 2 levels "0","1": 1 1 2 1 1 1 2 2 2 2 ...
##  $ fiveYearsProperty  : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 1 1 2 1 ...
##  $ metro              : Factor w/ 2 levels "0","1": 1 1 2 1 2 2 1 2 2 1 ...
##  $ precio             : int  22078 24507 32794 20579 29483 24649 63628 76198 61186 43279 ...
##  $ totalPrice         : num  170 360 470 580 330 200 649 1300 826 264 ...

Etapa EDA (Exploratory Data Analysis):

##VEMOS SI HAY ALGÚN DATO DUPLICADO
anyDuplicated(datos)
## [1] 2779

Vemos que hay 2779 inmuebles con las mismas características.

Vemos las distribuciones que tienen todas las variables:

skim(datos)
Data summary
Name datos
Number of rows 7455
Number of columns 19
_______________________
Column type frequency:
factor 7
numeric 12
________________________
Group variables None

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
floor 0 1.00 FALSE 37 6: 1497, 22: 545, 16: 479, 18: 452
buildingType 316 0.96 FALSE 4 4: 2830, 1: 2448, 3: 1834, 2: 27
renovacionCondicion 0 1.00 FALSE 4 4: 3431, 1: 2186, 3: 1651, 2: 187
buildingStrucuture 0 1.00 FALSE 6 6: 5259, 2: 1783, 4: 222, 1: 113
ascensor 0 1.00 FALSE 2 1: 5159, 0: 2296
fiveYearsProperty 0 1.00 FALSE 2 1: 4134, 0: 3321
metro 0 1.00 FALSE 2 1: 4442, 0: 3013

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
Lng 0 1 116.42 0.12 116.07 116.34 116.42 116.48 116.73 ▁▃▇▃▂
Lat 0 1 39.94 0.10 39.63 39.89 39.93 39.99 40.25 ▁▂▇▂▁
DOM 0 1 14.32 39.48 1.00 1.00 1.00 5.00 1352.00 ▇▁▁▁▁
seguidores 0 1 14.48 27.54 0.00 1.00 5.00 17.00 580.00 ▇▁▁▁▁
cuadrados 0 1 85.39 44.56 6.90 56.76 76.90 100.17 922.70 ▇▁▁▁▁
salon 0 1 1.92 0.84 0.00 1.00 2.00 2.00 7.00 ▆▇▃▁▁
drawingRoom 0 1 1.11 0.61 0.00 1.00 1.00 1.00 3.00 ▂▇▁▃▁
cocina 0 1 0.99 0.16 0.00 1.00 1.00 1.00 4.00 ▁▇▁▁▁
cuartodebaño 0 1 1.20 0.50 0.00 1.00 1.00 1.00 6.00 ▇▂▁▁▁
ladderRatio 0 1 0.36 0.21 0.02 0.25 0.33 0.50 10.00 ▇▁▁▁▁
precio 0 1 44911.28 23004.78 2.00 28992.50 39362.00 55221.50 156250.00 ▅▇▂▁▁
totalPrice 0 1 368.75 270.45 0.10 205.00 305.00 445.00 4650.00 ▇▁▁▁▁

VARIABLE OBJETIVO: “PRECIO TOTAL”

beijing + geom_point(data = datos, aes(datos$Lng, datos$Lat,color=totalPrice),size=1.3,alpha=1)+theme(axis.title= element_blank(), axis.text =element_blank()) 
## Warning: Use of `datos$Lng` is discouraged.
## ℹ Use `Lng` instead.
## Warning: Use of `datos$Lat` is discouraged.
## ℹ Use `Lat` instead.

Vemos cómo se distribuye el precio por toda la ciudad de Beijing. Los precios más altos están en el centro de la ciudad.

Análisis de variables numéricas:

profiling_num(datos)
variable mean std_dev variation_coef p_01 p_05 p_25 p_50 p_75 p_95 p_99 skewness kurtosis iqr range_98 range_80
Lng 1.164173e+02 1.234120e-01 0.0010601 116.14757 116.21267 116.33695 116.41683 116.48333 116.65546 116.69365 0.3069222 2.973006 1.46386e-01 [116.147569, 116.693646] [116.262442, 116.629641]
Lat 3.994473e+01 9.658310e-02 0.0024179 39.68235 39.79942 39.89359 39.93125 39.98763 40.09208 40.22928 0.3120597 4.536694 9.40335e-02 [39.682354, 40.22927972] [39.860989, 40.073376]
DOM 1.431925e+01 3.947815e+01 2.7569989 1.00000 1.00000 1.00000 1.00000 5.00000 84.00000 171.46000 9.0232783 204.412009 4.00000e+00 [1, 171.46] [1, 45]
seguidores 1.448048e+01 2.754146e+01 1.9019710 0.00000 0.00000 1.00000 5.00000 17.00000 61.00000 122.46000 5.8408133 65.796789 1.60000e+01 [0, 122.46] [0, 39]
cuadrados 8.539014e+01 4.456307e+01 0.5218761 21.97580 40.20000 56.76500 76.90000 100.17000 160.00000 238.26580 3.2253540 31.218939 4.34050e+01 [21.9758, 238.2658] [44.75, 136.936]
salon 1.918578e+00 8.368025e-01 0.4361576 1.00000 1.00000 1.00000 2.00000 2.00000 3.00000 4.00000 0.7981723 4.017120 1.00000e+00 [1, 4] [1, 3]
drawingRoom 1.110798e+00 6.070068e-01 0.5464601 0.00000 0.00000 1.00000 1.00000 1.00000 2.00000 2.00000 0.0137641 2.830933 0.00000e+00 [0, 2] [0, 2]
cocina 9.861838e-01 1.586335e-01 0.1608560 0.00000 1.00000 1.00000 1.00000 1.00000 1.00000 1.00000 -2.1914878 57.033985 0.00000e+00 [0, 1] [1, 1]
cuartodebaño 1.200000e+00 5.017811e-01 0.4181509 0.00000 1.00000 1.00000 1.00000 1.00000 2.00000 3.00000 2.2038069 11.209694 0.00000e+00 [0, 3] [1, 2]
ladderRatio 3.603976e-01 2.123318e-01 0.5891600 0.06100 0.14300 0.25000 0.33300 0.50000 0.66700 1.00000 13.5628601 574.793945 2.50000e-01 [0.061, 1] [0.167, 0.5]
precio 4.491128e+04 2.300478e+04 0.5122271 13068.10000 19154.50000 28992.50000 39362.00000 55221.50000 90717.40000 124896.86000 1.4205350 5.587178 2.62290e+04 [13068.1, 124896.86] [22046, 75214.2]
totalPrice 3.687540e+02 2.704459e+02 0.7334046 80.00000 120.00000 205.00000 305.00000 445.00000 826.60000 1350.00000 3.9412867 36.415539 2.40000e+02 [80, 1350] [147.24, 656.6]
# Graficamos las distibuciones de las variables numéricas

plot_num(datos)
## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the funModeling package.
##   Please report the issue at <https://github.com/pablo14/funModeling/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

mean(datos$precio)
## [1] 44911.28
mean(datos$totalPrice)
## [1] 368.754
mean(datos$cuadrados)
## [1] 85.39014

Vemos que el precio medio por metro cuadrado es de 44911.28 yenes. Y el precio medio por piso es aproximadamente 369 millones de yenes.

El tamaño medio de los pisos es de 85 metros cuadrados.

##TRANSFORMAMOS CON LOGARTIMOS LAS TRES VARIABLES QUE PRESENTAN UNA DISTRIBUCIÓN SESGADA HACIA LA IZQUIERDA:

datos$cuadrados1<-log(datos$cuadrados)
datos$precio1<-log(datos$precio)
datos$totalPrice1<-log(datos$totalPrice)
plot_num(datos)

ggplot(datos, aes(precio1)) + geom_histogram(bins=100)

ggplot(datos, aes(totalPrice1)) + geom_histogram(bins=100)

ggplot(datos, aes(cuadrados1)) + geom_histogram(bins=100)

ggplot(datos, aes(seguidores)) + geom_histogram(bins=100)

ggplot(datos, aes(ladderRatio)) + geom_histogram(bins=100)

ggplot(datos, aes(DOM)) + geom_histogram(bins=100)

VEMOS QUE QUEDA MUY MEJORADA LA DISTRIBUCIÓN DE LAS VARIABLES TRANSFORMADAS CON LOGARITMOS.

TAMBIÉN VEMOS QUE LAS VARIABLES: “DOM” Y “SEGUIDORES” TIENEN MUCHOS VALORES PEQUEÑOS CERCA DEL CERO. CON LO QUE A LO MEJOR NO CONTAMOS CON ELLAS A LA HORA DE HACER EL ESTUDIO Y EL MODELO. TODO PARECE INDICAR QUE SEAN ERRORES EN LA INTRODUCCIÓN DE DATOS, O TRANSFORMACIONES A CERO DE TODOS LOS VALORES MISSING.

#COMPROBAMOS LOS DATOS DE "DOM":

kable(datos %>% group_by(DOM) %>% summarise(count=n()))
DOM count
1 5320
2 93
3 59
4 58
5 66
6 48
7 56
8 37
9 44
10 55
11 58
12 41
13 32
14 38
15 35
16 35
17 36
18 30
19 38
20 29
21 34
22 25
23 28
24 41
25 28
26 28
27 21
28 16
29 17
30 20
31 23
32 18
33 28
34 19
35 19
36 25
37 18
38 21
39 13
40 11
41 12
42 15
43 9
44 9
45 13
46 14
47 10
48 14
49 11
50 12
51 10
52 9
53 10
54 11
55 13
56 12
57 10
58 9
59 11
60 15
61 11
62 9
63 9
64 9
65 5
66 11
67 9
68 7
69 9
70 6
71 12
72 10
73 8
74 4
75 6
76 7
77 12
78 7
79 6
80 8
81 10
82 5
83 8
84 5
85 5
86 7
87 9
88 8
89 8
90 2
91 8
92 8
93 6
94 7
95 6
96 7
97 1
98 6
99 4
100 8
101 9
102 3
103 3
104 5
105 6
106 2
107 4
108 4
109 3
110 5
111 2
112 1
113 8
114 3
115 3
116 1
117 2
118 4
119 3
120 4
121 2
122 3
124 4
125 3
126 2
127 8
128 5
129 6
130 6
131 5
132 3
133 2
134 3
135 3
136 2
138 3
139 3
140 2
141 1
142 2
143 3
144 2
145 1
146 5
147 5
148 1
149 2
150 3
151 1
152 2
153 2
155 2
156 1
157 2
158 2
159 1
160 2
161 1
162 1
164 3
166 4
167 1
168 1
169 2
170 1
171 3
172 1
174 3
175 1
176 1
177 2
179 1
180 1
182 2
184 1
186 1
187 1
188 2
191 1
193 1
196 2
197 3
198 1
200 1
201 2
206 2
207 1
208 1
209 2
210 1
211 1
213 2
215 1
217 1
223 1
224 1
232 1
235 2
237 1
238 1
241 1
253 1
254 1
260 1
261 1
263 2
269 1
270 1
271 1
272 1
276 1
281 1
295 1
297 1
312 1
340 1
347 1
369 1
370 1
392 1
398 1
414 1
430 1
457 1
487 1
546 1
1352 1

AQUÍ QUEDA COMPROBADO QUE 5320 DATOS DE 7455, SON “1”. ESTA VARIABLE LA QUITAREMOS DEL MODELO, YA QUE NO INTERESA PORQUE NO EXPLICA ENTONCES. SEA POR CUESTIONES DE BREVE DURACIÓN EN EL MERCADO (PARECE QUE PODRÍA SER LA RAZÓN MÁS VIABLE), O DE QUE HAYAN IMPUTADO NA´S AL VALOR DE 1, QUE NO CREO.

#COMPROBAMOS LOS DATOS DE "SEGUIDORES":

kable(datos %>% group_by(seguidores) %>% summarise(count=n()))
seguidores count
0 1719
1 646
2 480
3 371
4 368
5 281
6 239
7 215
8 214
9 178
10 143
11 152
12 132
13 111
14 123
15 110
16 107
17 106
18 94
19 79
20 68
21 67
22 75
23 60
24 65
25 61
26 43
27 46
28 44
29 35
30 36
31 33
32 23
33 37
34 30
35 25
36 26
37 26
38 33
39 29
40 25
41 25
42 25
43 27
44 16
45 18
46 27
47 15
48 12
49 19
50 12
51 18
52 7
53 8
54 9
55 13
56 16
57 9
58 13
59 19
60 13
61 15
62 15
63 9
64 8
65 9
66 7
67 6
68 7
69 10
70 5
71 4
72 9
73 8
74 12
75 11
76 5
77 5
78 3
79 6
80 6
81 9
82 5
83 5
84 3
85 8
86 3
87 5
88 3
89 4
90 5
91 7
92 3
93 3
94 3
95 2
96 4
97 3
98 8
99 3
100 3
101 4
102 4
103 1
104 2
105 6
106 3
107 2
108 1
109 2
110 4
112 4
114 4
115 2
116 1
117 5
119 2
120 2
121 5
122 1
123 3
126 4
127 1
129 1
130 1
131 2
132 3
133 3
134 1
137 1
138 1
139 1
140 2
142 5
147 1
148 1
149 1
150 1
151 1
152 1
153 1
155 3
158 1
162 1
166 1
167 1
176 1
182 1
183 2
186 1
188 1
189 2
195 2
197 1
200 1
202 1
207 1
212 1
220 1
221 1
222 1
231 1
240 1
242 1
266 1
274 1
306 1
308 1
315 1
343 1
361 1
396 1
414 1
417 1
580 1

CON ESTA VARIABLE LO QUE SUCEDE ES QUE TIENE MUCHOS VALORES PEQUEÑOS, PERO SE VE QUE NO ES UN ERROR EN LA INTRODUCIÓN DE DATOS. SOLAMENTE SIGNIFICA, QUE LA MAYORÍA DE LAS VENTAS DURARON EN EL MERCADO MUY POCOS DÍAS, O SE VENDIÓ EN EL MISMO DÍA DE PONER EL ANUNCIO.

TRABAJAMOS CON LA NUEVA BASE DE DATOS: datos1 Quedándonos con las variables transformadas anteriormente.

datos1<-datos[,-c(5,18,19)]
plot_num(datos1)

Nos quedan distribuciones más normalizadas.

  • Aunque la variable DOM sigue teniendo muchos CEROS, y tendríamos que averiguar si en Beijing la venta es fugaz en la ciudad. O si alguien transformó anteriormente todos los valores MISSING a unos.

  • Y vemos que los pisos que más abundan son con 1 cocina, 1 baño y 1 salón(drawingRoom), y 1 ó 2 habitaciones.

  • También se observa que la media de los metros cuadrados de los pisos, ronda los 85m2. Así que no se trata de apartamentos o estudios.

VEAMOS LA RELACIÓN QUE TIENEN NUESTRAS VARIABLES NUMÉRICAS CON LA VARIABLE OBJETIVO “TOTALPRICE”:

AHORA ESTUDIAMOS LAS VARIABLES CATEGÓRICAS:

freq(datos1)

##    floor frequency percentage cumulative_perc
## 1      6      1497      20.08           20.08
## 2     22       545       7.31           27.39
## 3     16       479       6.43           33.82
## 4     18       452       6.06           39.88
## 5     24       409       5.49           45.37
## 6     21       399       5.35           50.72
## 7     28       289       3.88           54.60
## 8     12       238       3.19           57.79
## 9     15       232       3.11           60.90
## 10    20       228       3.06           63.96
## 11     5       219       2.94           66.90
## 12    27       215       2.88           69.78
## 13    26       198       2.66           72.44
## 14    25       191       2.56           75.00
## 15    11       190       2.55           77.55
## 16    10       175       2.35           79.90
## 17     9       169       2.27           82.17
## 18     7       167       2.24           84.41
## 19    14       139       1.86           86.27
## 20    17       110       1.48           87.75
## 21    13       108       1.45           89.20
## 22    30       107       1.44           90.64
## 23     1        99       1.33           91.97
## 24    23        94       1.26           93.23
## 25    34        92       1.23           94.46
## 26    29        75       1.01           95.47
## 27     8        72       0.97           96.44
## 28    31        54       0.72           97.16
## 29     4        53       0.71           97.87
## 30    19        51       0.68           98.55
## 31     3        45       0.60           99.15
## 32     2        21       0.28           99.43
## 33    32        16       0.21           99.64
## 34    33        12       0.16           99.80
## 35    42         8       0.11           99.91
## 36    37         4       0.05           99.96
## 37    36         3       0.04          100.00

##   buildingType frequency percentage cumulative_perc
## 1            4      2830      37.96           37.96
## 2            1      2448      32.84           70.80
## 3            3      1834      24.60           95.40
## 4         <NA>       316       4.24           99.64
## 5            2        27       0.36          100.00

##   renovacionCondicion frequency percentage cumulative_perc
## 1                   4      3431      46.02           46.02
## 2                   1      2186      29.32           75.34
## 3                   3      1651      22.15           97.49
## 4                   2       187       2.51          100.00

##   buildingStrucuture frequency percentage cumulative_perc
## 1                  6      5259      70.54           70.54
## 2                  2      1783      23.92           94.46
## 3                  4       222       2.98           97.44
## 4                  1       113       1.52           98.96
## 5                  3        73       0.98           99.94
## 6                  5         5       0.07          100.00

##   ascensor frequency percentage cumulative_perc
## 1        1      5159       69.2            69.2
## 2        0      2296       30.8           100.0

##   fiveYearsProperty frequency percentage cumulative_perc
## 1                 1      4134      55.45           55.45
## 2                 0      3321      44.55          100.00

##   metro frequency percentage cumulative_perc
## 1     1      4442      59.58           59.58
## 2     0      3013      40.42          100.00
## [1] "Variables processed: floor, buildingType, renovacionCondicion, buildingStrucuture, ascensor, fiveYearsProperty, metro"

**En primer lugar vemos que las alturas más vendidas son los pisos: 6ªplanta (una quinta parte del total de ventas-20%) y le siguen aunque con distancia los pisos 16ª,18ª,21ª, 22ª y 24ªplanta.

**Con respecto al tipo de estructura, se ve claramente que las mayores ventas, se dan en “lámina” y en “combinación de lamina y torre”, y lo que apenas se vende (no sabemos si porque este tipo de edificación no abunda en Beijing), son los “bungalows”.

**Y con respecto a la condición de reforma del piso, vemos que abundan las ventas que han tenido una alta-reforma, con casi un 46% de las ventas.

**En el material de la estructura del edificio, arrasan por encima del resto las construcciones con “acero y hormigón” con más de un 70% de las ventas. Y vemos como el material de madera apenas es utilizado, lo que cuadra perfectamente con la poca construcción de bungalows.

**Como cabía de esperar, las ventas de edificios con ascensor superan con creces a los que no disponen de este servicio. Siendo las ventas con ascensor del 70% frente al 30% sin ascensor.

**Respecto a la antiguedad del edificio, priman las ventas de edificios en las que el dueño las ha adquirido hace menos de 5 años. Pero tampoco hay una distancia tan grande con respecto a las ventas que no cumplen esto.

**El metro de una ciudad tan grande siempre va a ser un reclamo para darle categoría al piso que está en venta, y claramente se ve que el número total de ventas de los pisos que están cerca a ellos es mayor con el 60% de las ventas frente al 40% de los que no tienen este servicio de transporte cerca.

#DISTRIBUCIÓN DE LA VARIABLE "FLOOR" EN LA CIUDAD:

beijing + geom_point(data = datos, aes(Lng, Lat, color = floor),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())

Vemos que los edificios más altos, con más de 30 plantas están también en el centro.

#DISTRIBUCIÓN DE LA VARIABLE "TIPO DE CONSTRUCCIÓN" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = buildingType),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())

Vemos que apenas hay bungalows en la ciudad.

#DISTRIBUCIÓN DE LA VARIABLE "CONDICIÓN DE RENOVACIÓN" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = renovacionCondicion),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())

Están bastante repartidas por toda la ciudad, no parece que dependa tanto de la ubicación.

#DISTRIBUCIÓN DE LA VARIABLE "ESTRUCTURA" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = buildingStrucuture),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())

Los únicos edificios hechos en madera, que serán bungalows están todos en el centro de la ciudad. Suponemos que será la parte antigua de la ciudad.

#DISTRIBUCIÓN DE LA VARIABLE "CONDICIÓN DE REFORMA" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = renovacionCondicion),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())

Las reformas que tienen los inmuebles no dependen tanto de la ubicación, está bastante repartido.

#DISTRIBUCIÓN DE LA VARIABLE "ASCENSOR" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = ascensor),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())

En los distritos del norte vemos claramente que no tienen ascensor los inmuebles. Y en puro centro de la ciudad tampoco, se empezarían a instalar en pisos de un área fuera del centro histórico.

#DISTRIBUCIÓN DE LA VARIABLE "METRO" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = metro),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())

Vemos como se podía esperar que las viviendas que disponen del servicio de metro cerca, son las que están más céntricas.

#DISTRIBUCIÓN DE LA VARIABLE "FIVEYEARSPROPERTY" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = fiveYearsProperty),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())

Está bastante repartido por toda la ciudad, no depende tanto de la ubicación.

Preprocesado:

DATOS AUSENTES:

#ESTUDIO DATOS AUSENTES EN NUESTRA BASE DE DATOS:
colSums(is.na(datos1))
##                 Lng                 Lat                 DOM          seguidores 
##                   0                   0                   0                   0 
##               salon         drawingRoom              cocina        cuartodebaño 
##                   0                   0                   0                   0 
##               floor        buildingType renovacionCondicion  buildingStrucuture 
##                   0                 316                   0                   0 
##         ladderRatio            ascensor   fiveYearsProperty               metro 
##                   0                   0                   0                   0 
##          cuadrados1             precio1         totalPrice1 
##                   0                   0                   0

TENEMOS DATOS AUSENTES EN LA VARIABLE “buildingType”: estilo de edificación. Y faltan 316 datos de un total de 7455 observaciones, que no llega al 5% de los datos. Así que podemos tratarlos más adelante.

plot_missing(datos1)

md.pattern(datos1, rotate.names = T)

##      Lng Lat DOM seguidores salon drawingRoom cocina cuartodebaño floor
## 7139   1   1   1          1     1           1      1            1     1
## 316    1   1   1          1     1           1      1            1     1
##        0   0   0          0     0           0      0            0     0
##      renovacionCondicion buildingStrucuture ladderRatio ascensor
## 7139                   1                  1           1        1
## 316                    1                  1           1        1
##                        0                  0           0        0
##      fiveYearsProperty metro cuadrados1 precio1 totalPrice1 buildingType    
## 7139                 1     1          1       1           1            1   0
## 316                  1     1          1       1           1            0   1
##                      0     0          0       0           0          316 316
table(datos1$buildingType)
## 
##    1    2    3    4 
## 2448   27 1834 2830

Se ve claramente que las mayores ventas, se dan en “lámina” y en “combinación de lamina y torre”, y lo que apenas se vende (no sabemos si porque este tipo de edificación no abunda en Beijing), son los “bungalows”.

VAMOS A IMPUTARLOS CON VARIOS MÉTODOS, Y VEREMOS CUÁL SE AJUSTA MÁS A NUESTROS DATOS REALES:

**Y luego, representaremos la función de densidad del dataframe original -SIN los NAs- vs la del dataframe completo con los datos imputados. De esta manera, podemos ver, de manera gráfica, la bondad de nuestras imputaciones. Transformamos momentáneamente a numérica la variable “buildingType” para verlo.

datos1$buildingType<-as.numeric(datos1$buildingType)
# imputamos por el método por defecto de mice: "pmm" (ecuaciones encadenadas)

imputed_data_pmm = mice(datos1,m=5,verbose=T)
## 
##  iter imp variable
##   1   1  buildingType
##   1   2  buildingType
##   1   3  buildingType
##   1   4  buildingType
##   1   5  buildingType
##   2   1  buildingType
##   2   2  buildingType
##   2   3  buildingType
##   2   4  buildingType
##   2   5  buildingType
##   3   1  buildingType
##   3   2  buildingType
##   3   3  buildingType
##   3   4  buildingType
##   3   5  buildingType
##   4   1  buildingType
##   4   2  buildingType
##   4   3  buildingType
##   4   4  buildingType
##   4   5  buildingType
##   5   1  buildingType
##   5   2  buildingType
##   5   3  buildingType
##   5   4  buildingType
##   5   5  buildingType
# completamos valores con el resto de columnas

datos_imputados_pmm = complete(imputed_data_pmm)
# Comprobamos que ya no existen valores ausentes

sapply(datos_imputados_pmm, function(x) sum(is.na(x)))
##                 Lng                 Lat                 DOM          seguidores 
##                   0                   0                   0                   0 
##               salon         drawingRoom              cocina        cuartodebaño 
##                   0                   0                   0                   0 
##               floor        buildingType renovacionCondicion  buildingStrucuture 
##                   0                   0                   0                   0 
##         ladderRatio            ascensor   fiveYearsProperty               metro 
##                   0                   0                   0                   0 
##          cuadrados1             precio1         totalPrice1 
##                   0                   0                   0
#Representamos la función de densidad del dataframe original -SIN los NAs- vs la del dataframe completo con los datos imputados. 

plot(density(datos1$buildingType,na.rm = T),col=2,main="Variable buildingType. Método pmm")
lines(density(datos_imputados_pmm$buildingType),col=3)

# Con MICE y Random Forest

imputed_data_rf <- mice(datos1, meth = "rf", ntree = 3)
## 
##  iter imp variable
##   1   1  buildingType
##   1   2  buildingType
##   1   3  buildingType
##   1   4  buildingType
##   1   5  buildingType
##   2   1  buildingType
##   2   2  buildingType
##   2   3  buildingType
##   2   4  buildingType
##   2   5  buildingType
##   3   1  buildingType
##   3   2  buildingType
##   3   3  buildingType
##   3   4  buildingType
##   3   5  buildingType
##   4   1  buildingType
##   4   2  buildingType
##   4   3  buildingType
##   4   4  buildingType
##   4   5  buildingType
##   5   1  buildingType
##   5   2  buildingType
##   5   3  buildingType
##   5   4  buildingType
##   5   5  buildingType
datos_imputados_pmm_rf = complete(imputed_data_rf)
#Representamos la función de densidad del dataframe original -SIN los NAs- vs la del dataframe completo con los datos imputados.

plot(density(datos1$buildingType,na.rm = T),col=2,main="Variable buildingType. Método Random Forest")
lines(density(datos_imputados_pmm_rf$buildingType),col=3)

A LA VISTA DE LAS GRÁFICAS, AMBOS MÉTODOS AJUSTAN BASTANTE BIEN. PERO ALGO MÁS AJUSTADO PARECE QUE QUEDA CON EL MÉTODO MICE-PMM. ASÍ NOS QUEDAREMOS CON ESTA BASE DE DATOS, PARA TRABAJAR CON ELLA DE AQUÍ EN ADELANTE: “datos2<-datos_imputados_pmm” **Y VOLVEMOS A PASAR A FACTOR LA VARIABLE “buildingType” .

datos_imputados_pmm$buildingType<-as.factor(datos_imputados_pmm$buildingType)
#NUEVA BASE DE DATOS CON NA`S IMPUTADOS:

head(datos_imputados_pmm)
Lng Lat DOM seguidores salon drawingRoom cocina cuartodebaño floor buildingType renovacionCondicion buildingStrucuture ladderRatio ascensor fiveYearsProperty metro cuadrados1 precio1 totalPrice1
116.2324 40.23553 546 6 2 1 1 1 6 4 1 2 0.333 0 1 0 4.343805 10.002337 5.135798
116.2495 40.22179 457 4 3 2 1 2 7 4 4 2 0.500 0 1 0 4.989752 10.106714 5.886104
116.5239 39.92328 430 3 1 0 0 0 32 1 3 6 0.500 1 1 1 4.965080 10.398001 6.152733
116.4300 40.06624 487 52 5 2 1 3 6 4 3 2 0.500 0 1 0 5.641375 9.932026 6.363028
116.5209 39.91885 392 222 3 2 1 1 6 4 2 2 0.500 0 1 1 4.717874 10.291569 5.799093
116.2258 39.80226 398 207 2 1 1 1 6 3 2 1 0.250 0 0 1 4.396176 10.112492 5.298317
str(datos_imputados_pmm)
## 'data.frame':    7455 obs. of  19 variables:
##  $ Lng                : num  116 116 117 116 117 ...
##  $ Lat                : num  40.2 40.2 39.9 40.1 39.9 ...
##  $ DOM                : int  546 457 430 487 392 398 369 370 347 272 ...
##  $ seguidores         : int  6 4 3 52 222 207 73 26 114 81 ...
##  $ salon              : int  2 3 1 5 3 2 3 4 3 1 ...
##  $ drawingRoom        : int  1 2 0 2 2 1 1 2 1 1 ...
##  $ cocina             : int  1 1 0 1 1 1 1 1 1 1 ...
##  $ cuartodebaño       : int  1 2 0 3 1 1 1 2 1 1 ...
##  $ floor              : Factor w/ 37 levels "1","2","3","4",..: 6 7 32 6 6 6 18 8 9 18 ...
##  $ buildingType       : Factor w/ 4 levels "1","2","3","4": 4 4 1 4 4 3 1 4 3 1 ...
##  $ renovacionCondicion: Factor w/ 4 levels "1","2","3","4": 1 4 3 3 2 2 3 3 4 4 ...
##  $ buildingStrucuture : Factor w/ 6 levels "1","2","3","4",..: 2 2 6 2 2 1 6 6 6 6 ...
##  $ ladderRatio        : num  0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
##  $ ascensor           : Factor w/ 2 levels "0","1": 1 1 2 1 1 1 2 2 2 2 ...
##  $ fiveYearsProperty  : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 1 1 2 1 ...
##  $ metro              : Factor w/ 2 levels "0","1": 1 1 2 1 2 2 1 2 2 1 ...
##  $ cuadrados1         : num  4.34 4.99 4.97 5.64 4.72 ...
##  $ precio1            : num  10 10.11 10.4 9.93 10.29 ...
##  $ totalPrice1        : num  5.14 5.89 6.15 6.36 5.8 ...

ESTUDIO DE VALORES ANÓMALOS: “OUTLIERS” Cogemos solamente las variables numéricas.

datos_imputados_pmm  %>%
  diagnose_outlier(cuadrados1,precio1,totalPrice1,DOM,ladderRatio,seguidores)
variables outliers_cnt outliers_ratio outliers_mean with_mean without_mean
cuadrados1 cuadrados1 160 2.1462106 4.209594 4.3408265 4.3437048
precio1 precio1 67 0.8987257 7.961943 10.5819780 10.6057385
totalPrice1 totalPrice1 108 1.4486922 5.137513 5.7136677 5.7221371
DOM DOM 1561 20.9389671 62.745035 14.3192488 1.4938921
ladderRatio ladderRatio 224 3.0046948 1.060411 0.3603976 0.3387128
seguidores seguidores 675 9.0543260 80.211852 14.4804829 7.9364307
datos_imputados_pmm  %>% 
  plot_outlier(cuadrados1,precio1,totalPrice1,DOM,ladderRatio,seguidores)

**vemos cómo cambian las distribuciones de las variables cuando se eliminan los “outliers”. Pero hay que tener en cuenta, cuando tiene sentido eliminarlos y cuando no lo tiene. Por ejemplo: - en la variable de “cuadrados1”, seguramente se trata de pisos que se salen de la media en cuanto a tamaño. Estudiaremos si es error o no más adelante, aunque todo indica que sí. - En las variable “precio1” y “totalPrice” mejoran notablemente las distribuciones, parece que los outliers sean errores en la entrada de datos. imprimiremos sus outliers para estudiar esto. - La variable “DOM” sigue guardando su distribución llena de CEROS que en realidad, no nos interesará contar con ella para hacer los estudios siguientes, al igual que la variable “seguidores”. - LatterRatio mejora la distribución sin outliers, aunque también tiene muchos datos CEROS.

IMPRIMIMOS LOS OUTLIERS DE “PRECIO TOTAL”:( desde nuestra base de datos original, antes de hacer la transformación logarítmica.)

boxplot(datos$totalPrice)
outprecioTotal<-boxplot(datos$totalPrice)$out

sort(outprecioTotal)
##   [1]  806.0  808.0  808.0  809.0  810.0  810.0  810.0  810.0  810.0  810.0
##  [11]  813.6  815.0  815.0  815.0  815.0  817.0  817.5  818.0  819.0  820.0
##  [21]  820.0  820.0  820.0  820.0  820.0  821.0  823.0  825.0  825.0  826.0
##  [31]  828.0  828.0  828.0  830.0  830.0  830.0  830.0  830.0  830.0  830.0
##  [41]  830.0  830.0  830.0  830.0  832.0  835.0  835.0  835.0  838.0  839.9
##  [51]  840.0  840.0  840.0  840.0  840.0  845.0  846.0  848.0  850.0  850.0
##  [61]  850.0  850.0  850.0  850.0  851.0  851.8  852.0  852.0  855.0  855.0
##  [71]  855.0  856.0  856.0  856.0  857.0  858.0  858.0  858.0  860.0  860.0
##  [81]  860.0  860.0  865.0  866.0  870.0  870.0  870.0  870.0  870.6  874.0
##  [91]  877.0  880.0  880.0  880.0  880.0  880.0  880.0  883.0  885.0  890.0
## [101]  890.0  890.0  890.0  895.0  896.0  898.0  898.0  900.0  900.0  900.0
## [111]  900.0  900.0  900.0  900.0  900.0  900.0  900.0  900.0  900.0  900.0
## [121]  905.0  906.0  908.0  910.0  910.0  913.0  915.0  918.0  920.0  920.0
## [131]  920.0  920.0  920.0  920.0  920.0  925.0  925.0  926.0  928.0  930.0
## [141]  930.0  930.0  930.0  930.0  935.0  935.0  937.0  937.0  938.8  940.0
## [151]  940.0  940.0  946.0  948.0  950.0  950.0  950.0  950.0  950.0  950.0
## [161]  950.0  952.0  955.0  955.0  955.0  956.0  960.0  960.0  960.0  960.0
## [171]  960.0  960.0  962.0  965.0  966.0  968.0  970.0  970.0  970.0  972.0
## [181]  975.0  979.0  980.0  980.0  980.0  980.0  980.0  980.0  980.0  980.0
## [191]  981.0  983.0  985.0  986.0  990.0  992.0  998.0  999.0 1000.0 1000.0
## [201] 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0
## [211] 1005.0 1010.0 1010.0 1010.0 1010.0 1022.0 1025.0 1030.0 1035.0 1038.0
## [221] 1038.0 1039.8 1040.0 1040.0 1042.0 1048.0 1048.0 1050.0 1050.0 1050.0
## [231] 1059.0 1060.0 1060.0 1065.0 1070.0 1080.0 1080.0 1080.0 1080.0 1090.0
## [241] 1090.0 1090.0 1099.0 1100.0 1100.0 1100.0 1100.0 1100.0 1100.0 1100.0
## [251] 1100.0 1100.0 1115.0 1120.0 1120.0 1120.0 1120.0 1120.0 1120.0 1120.0
## [261] 1130.0 1130.0 1140.0 1140.0 1145.0 1146.0 1150.0 1150.0 1150.0 1150.0
## [271] 1150.0 1150.9 1158.0 1160.0 1160.0 1160.0 1160.0 1170.0 1170.0 1180.0
## [281] 1180.0 1180.0 1180.0 1182.0 1190.0 1195.0 1195.0 1200.0 1200.0 1200.0
## [291] 1215.0 1220.0 1220.0 1230.0 1237.0 1238.0 1250.0 1250.0 1250.0 1251.0
## [301] 1255.0 1258.0 1260.0 1260.0 1270.0 1270.0 1270.0 1285.0 1285.0 1288.0
## [311] 1292.0 1296.0 1300.0 1300.0 1300.0 1300.0 1300.0 1300.0 1300.0 1300.0
## [321] 1308.0 1309.0 1320.0 1324.0 1330.0 1345.0 1350.0 1350.0 1350.0 1350.0
## [331] 1350.0 1355.0 1355.0 1360.0 1360.0 1368.0 1380.0 1380.0 1385.0 1400.0
## [341] 1400.0 1400.0 1400.0 1410.0 1430.0 1435.0 1440.0 1450.0 1450.0 1460.0
## [351] 1490.6 1500.0 1500.0 1500.0 1505.0 1510.0 1510.0 1510.0 1528.0 1540.0
## [361] 1550.0 1550.0 1560.0 1570.0 1580.0 1590.0 1600.0 1600.0 1620.0 1660.0
## [371] 1670.0 1688.0 1700.0 1700.0 1730.0 1745.0 1760.0 1760.0 1780.0 1800.0
## [381] 1880.0 1980.0 2030.0 2050.0 2100.0 2130.0 2250.0 2300.0 2400.0 2420.0
## [391] 2490.0 2600.0 2620.0 2680.0 2700.0 2738.0 2742.6 3300.0 3350.0 3620.0
## [401] 3840.0 4250.0 4650.0
min(datos$totalPrice)
## [1] 0.1
max(datos$totalPrice)
## [1] 4650
plot(datos$totalPrice)

VEMOS QUE LA MEDIA DE LOS PRECIOS MÁS ALTOS, SON UNOS 1200-1500 MILLONES DE YENES. ASÍ QUE TODO INDICA, AUNQUE CON EL CAMBIO DE MONEDA Y DE PAÍS PUEDE SER MÁS COMPLICADO SITUARNOS EN ESE MERCADO DE PRECIOS, QUE DEBEN SER ERRORES LOS VALORES QUE ESTÁN POR ENCIMA DE ESTOS. AL METER LOS DATOS DE 300 Y 400 MILLONES DE YENES, QUE HAYAN AÑADIDO UN CERO MÁS POR ERROR, Y ASÍ APARECER PISOS DE 3000-4000 MILLONES DE YENES. ASÍ QUE VAMOS A IMPUTAR LOS OUTLIERS DE ESTA VARIABLE.

IMPRIMIMOS LOS OUTLIERS DE LA VARIABLE METROS “CUADRADOS”:

boxplot(datos$cuadrados)
outCuadrados<-boxplot(datos$cuadrados)$out

sort(outCuadrados)
##   [1] 165.84 165.96 165.96 165.96 165.96 166.04 166.04 166.17 166.17 166.17
##  [11] 166.66 166.90 166.90 167.00 167.00 167.00 167.11 167.12 167.15 167.50
##  [21] 167.60 167.67 167.70 167.97 167.97 168.06 168.37 168.37 168.49 168.71
##  [31] 168.95 169.00 169.14 169.76 169.76 169.89 169.92 169.92 170.21 170.33
##  [41] 170.61 170.65 170.80 171.00 171.05 171.06 171.06 171.20 171.49 171.58
##  [51] 171.58 171.68 172.13 172.41 172.44 173.00 173.49 173.64 173.74 173.95
##  [61] 174.00 174.33 174.33 174.60 174.61 174.68 174.70 174.70 174.72 174.72
##  [71] 174.85 174.86 175.00 175.00 175.00 175.55 175.62 175.70 176.00 176.00
##  [81] 176.00 176.02 176.02 176.03 176.88 176.97 176.97 177.02 177.19 177.19
##  [91] 177.32 177.32 177.39 177.76 177.79 177.89 178.21 178.21 178.55 178.59
## [101] 178.87 179.05 179.14 179.14 179.41 179.48 179.48 179.79 179.95 180.30
## [111] 180.43 180.70 181.16 181.31 181.31 181.68 181.68 181.93 182.00 182.00
## [121] 182.02 182.02 182.13 182.29 182.46 183.00 183.09 183.39 183.47 183.91
## [131] 184.23 185.34 185.57 186.00 186.26 186.26 186.46 186.47 186.47 186.59
## [141] 186.67 187.26 187.58 188.25 188.56 188.56 188.80 189.16 189.65 190.85
## [151] 190.85 190.97 190.97 190.97 190.97 191.34 191.65 192.29 192.29 192.49
## [161] 193.41 193.49 194.00 194.15 196.25 196.93 199.59 199.91 200.00 201.19
## [171] 201.89 201.89 201.89 201.90 202.00 202.51 203.43 203.65 204.40 204.66
## [181] 204.66 204.66 205.00 205.09 205.25 205.37 205.54 205.54 205.94 205.95
## [191] 205.95 205.95 207.12 207.21 208.73 208.79 210.19 211.03 211.61 211.88
## [201] 212.54 212.64 213.47 214.03 214.98 215.00 215.60 215.89 216.03 216.12
## [211] 216.43 216.48 216.89 216.98 218.10 219.22 219.22 219.26 219.39 219.39
## [221] 219.95 219.95 220.00 220.00 220.36 220.40 220.66 220.78 221.80 222.18
## [231] 222.24 223.00 223.16 223.53 223.80 225.00 225.64 226.95 227.74 228.17
## [241] 228.88 228.88 228.96 229.00 229.42 229.43 229.50 229.79 229.88 231.24
## [251] 232.18 232.50 236.73 236.99 237.82 237.86 237.93 238.66 239.54 240.97
## [261] 243.67 245.02 246.46 250.00 250.00 250.45 251.82 253.00 253.02 254.89
## [271] 255.68 256.06 258.81 259.00 261.96 262.22 266.31 266.86 268.72 270.00
## [281] 271.00 272.00 272.00 272.94 273.12 273.26 274.00 275.00 279.16 279.16
## [291] 281.38 281.85 281.88 284.87 294.00 296.57 296.57 296.57 296.57 297.58
## [301] 302.82 304.73 304.73 311.75 320.00 328.06 334.00 335.77 342.28 348.89
## [311] 355.00 356.67 358.00 361.00 367.00 369.40 372.82 374.90 380.00 382.00
## [321] 383.52 409.00 411.29 435.51 440.84 449.35 452.80 458.00 469.55 495.65
## [331] 573.77 922.70
min(datos$cuadrados)
## [1] 6.9
max(datos$cuadrados)
## [1] 922.7
plot(datos$cuadrados)

VEMOS QUE DE MANERA MEDIA SIN TENER EN CUENTA LOS VALORES ATÍPICOS, COMO NÚMEROS DE METROS CUADRADOS NO LLEGA A 200M2. LO QUE TODO INDICA QUE LOS VALORES ATÍPICOS DE 400M2, 600M2 Y 900M2 SE DEBAN A ERRORES EN LA INTRODUCIÓN DE LOS DATOS. LOS IMPUTAREMOS.

LIMPIAMOS OUTLIERS DE TODAS LAS VARIABLES ANTERIORES PARA MEJORAR BASE DATOS:

variables = c("cuadrados1","precio1","totalPrice1","DOM","ladderRatio"  ,"seguidores")
var_stop_bottom_top <- prep_outliers(data=datos_imputados_pmm, 
                                       input=variables, 
                                       type='stop', top_percent  = 0.01,method = "bottom_top")
datos_limpios<-var_stop_bottom_top
sapply(datos_limpios, function(x) sum(is.na(x)))
##                 Lng                 Lat                 DOM          seguidores 
##                   0                   0                   0                   0 
##               salon         drawingRoom              cocina        cuartodebaño 
##                   0                   0                   0                   0 
##               floor        buildingType renovacionCondicion  buildingStrucuture 
##                   0                   0                   0                   0 
##         ladderRatio            ascensor   fiveYearsProperty               metro 
##                   0                   0                   0                   0 
##          cuadrados1             precio1         totalPrice1 
##                   0                   0                   0

EN ADELANTE TRABAJAREMOS CON LA BASE DE DATOS: “datos_limpios”

str(datos_limpios)
## 'data.frame':    7455 obs. of  19 variables:
##  $ Lng                : num  116 116 117 116 117 ...
##  $ Lat                : num  40.2 40.2 39.9 40.1 39.9 ...
##  $ DOM                : num  171 171 171 171 171 ...
##  $ seguidores         : num  6 4 3 52 122 ...
##  $ salon              : int  2 3 1 5 3 2 3 4 3 1 ...
##  $ drawingRoom        : int  1 2 0 2 2 1 1 2 1 1 ...
##  $ cocina             : int  1 1 0 1 1 1 1 1 1 1 ...
##  $ cuartodebaño       : int  1 2 0 3 1 1 1 2 1 1 ...
##  $ floor              : Factor w/ 37 levels "1","2","3","4",..: 6 7 32 6 6 6 18 8 9 18 ...
##  $ buildingType       : Factor w/ 4 levels "1","2","3","4": 4 4 1 4 4 3 1 4 3 1 ...
##  $ renovacionCondicion: Factor w/ 4 levels "1","2","3","4": 1 4 3 3 2 2 3 3 4 4 ...
##  $ buildingStrucuture : Factor w/ 6 levels "1","2","3","4",..: 2 2 6 2 2 1 6 6 6 6 ...
##  $ ladderRatio        : num  0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
##  $ ascensor           : Factor w/ 2 levels "0","1": 1 1 2 1 1 1 2 2 2 2 ...
##  $ fiveYearsProperty  : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 1 1 2 1 ...
##  $ metro              : Factor w/ 2 levels "0","1": 1 1 2 1 2 2 1 2 2 1 ...
##  $ cuadrados1         : num  4.34 4.99 4.97 5.47 4.72 ...
##  $ precio1            : num  10 10.11 10.4 9.93 10.29 ...
##  $ totalPrice1        : num  5.14 5.89 6.15 6.36 5.8 ...

GRÁFICAS VARIABLES FRENTE A VARIABLE OBJETIVO “PRECIO TOTAL”:

ggplot(datos_limpios, aes(x = exp(cuadrados1), y =exp(totalPrice1))) + 
      geom_smooth() 
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(datos_limpios, aes(x = exp(precio1) , y =exp(totalPrice1))) + 
      geom_smooth() 
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(datos_limpios, aes(x = ladderRatio  , y =exp(totalPrice1))) + 
      geom_smooth()  
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(datos_limpios, aes(x = seguidores  , y =exp(totalPrice1))) + 
      geom_smooth() 
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(datos_limpios, aes(x = DOM  , y =exp(totalPrice1))) + 
      geom_smooth()  
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(datos_limpios, aes(x = Lng , y =exp(totalPrice1))) + 
      geom_smooth()  
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(datos_limpios, aes(x = Lat  , y =exp(totalPrice1))) + 
      geom_smooth()  
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

Como ya habíamos advertido anteriormente, la variable PRECIO TOTAL depende linealmente de las variables (PRECIO, METROS CUADRADOS, ESCALERAS Y DÍAS QUE ESTÁ EN EL MERCADO– la entendemos, como que los precios más baratos enseguida se venden, y los precios altos duran más tiempo anunciados, ya que no están al alcance de cualquiera. Y las variables de LATITUD Y LONGITUD, alcanzan precios más altos en la parte central de ambos, es decir en el centro de la ciudad de Beijing.

“PRECIO TOTAL EN FUNCIÓN DEL TIPO DE CONSTRUCCIÓN”

ggplot(datos_limpios , aes(x= buildingType, y=exp(totalPrice1), color = buildingType))+
  geom_boxplot() + labs(title = "PRECIO TOTAL EN FUNCIÓN DEL TIPO DE CONSTRUCCIÓN", y =" totalPrice ")

El precio más alto es el de las Torres, y el más bajo es el de los bungalows que suelen ser de madera y que solamente han vendido 27. Un número bajísimo con respecto al resto de construcciones.

table(datos_limpios$buildingType)
## 
##    1    2    3    4 
## 2482   27 1902 3044

“PRECIO TOTAL EN FUNCIÓN DEL MATERIAL DE CONSTRUCCIÓN”

ggplot(datos_limpios, aes(x= buildingStrucuture, y=exp(totalPrice1), color = buildingStrucuture))+
  geom_boxplot() + labs(title = "PRECIO TOTAL EN FUNCIÓN DEL MATERIAL DE CONSTRUCCIÓN", y ="PRECIO TOTAL")

El precio aumenta en los pisos de acero y hormigón y menor en la madera (material con el que se construyen los bungalows). No parece depender mucho la estructura del edificio con el precio total, no incluiremos esta variable en el modelo.

table(datos_limpios$buildingStrucuture)
## 
##    1    2    3    4    5    6 
##  113 1783   73  222    5 5259

“PRECIO EN FUNCIÓN DE LA REFORMA DEL PISO”

ggplot(datos_limpios, aes(x= renovacionCondicion, y=exp(totalPrice1), color = renovacionCondicion))+
  geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DE LA REFORMA DEL PISO", y ="PRECIO TOTAL")

El precio aumenta cuanto más reformado está el piso.

table(datos_limpios$renovacionCondicion)
## 
##    1    2    3    4 
## 2186  187 1651 3431

“PRECIO EN FUNCIÓN DE LA PROXIMIDAD DEL METRO”

ggplot(datos_limpios, aes(x= metro, y=exp(totalPrice1), color = metro))+
  geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DE LA PROXIMIDAD DEL METRO", y ="PRECIO TOTAL")

El precio aumenta un poco en los pisos cercanos a una parada de metro, pero con muy poca diferencia de precios.

table(datos_limpios$metro)
## 
##    0    1 
## 3013 4442

“PRECIO EN FUNCIÓN DE FINCA CON ASCENSOR”

ggplot(datos_limpios, aes(x= ascensor, y=exp(totalPrice1), color = ascensor))+
  geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DE FINCA CON ASCENSOR", y ="PRECIO TOTAL")

El precio SÍ aumenta en las fincas con ascensor, pero con poca diferencia con respecto a los pisos que no tienen.

table(datos_limpios$ascensor)
## 
##    0    1 
## 2296 5159

“PRECIO EN FUNCIÓN DE LA ALTURA DEL PISO”

ggplot(datos_limpios, aes(x= floor, y=exp(totalPrice1), color = floor))+
  geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DE LA ALTURA DEL PISO", y ="PRECIO TOTAL")

Las alturas más bajas y más altas son las más cotizadas.

table(datos_limpios$floor)
## 
##    1    2    3    4    5    6    7    8    9   10   11   12   13   14   15   16 
##   99   21   45   53  219 1497  167   72  169  175  190  238  108  139  232  479 
##   17   18   19   20   21   22   23   24   25   26   27   28   29   30   31   32 
##  110  452   51  228  399  545   94  409  191  198  215  289   75  107   54   16 
##   33   34   36   37   42 
##   12   92    3    4    8

La altura más vendida, es la altura 6ªplanta del edificio, con bastante diferencia del resto. No sé si serán edificios de 6 alturas en las que se cotice más como la última planta o ático. O que tenga que ver con algo supersticioso o de creencia en el número 6. AL desconocer estos datos no se puede confirmar nada, pero es curioso.

“PRECIO EN FUNCIÓN DEL TIEMPO QUE TIENE EL PISO”

ggplot(datos_limpios, aes(x= fiveYearsProperty, y=exp(totalPrice1), color = fiveYearsProperty))+
  geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DEL TIEMPO QUE TIENE EL PISO", y ="PRECIO TOTAL")

Los pisos que tienen menos tiempo de construcción se venden con un precio más alto. Pero es tan poca la diferencia entre unos y otros, que no da la suficiente información como para tenerla en cuenta en el modelo.

table(datos_limpios$fiveYearsProperty)
## 
##    0    1 
## 3321 4134

CORRELACIÓN ENTRE VARIABLES NUMÉRICAS:

Elegimos las variables numéricas para hacer las correlaciones, y antes quitamos las que no lo son, y quitamos las variables “latitud” y “longitud” por ser coordenadas.

numericas=datos_limpios[,c(3,4,5,6,7,8,13,17,18,19)]
corr_datos = as.data.frame((cor(numericas)))

round(corr_datos,2)
DOM seguidores salon drawingRoom cocina cuartodebaño ladderRatio cuadrados1 precio1 totalPrice1
DOM 1.00 0.52 0.09 0.03 0.01 0.08 0.02 0.08 0.19 0.22
seguidores 0.52 1.00 0.04 -0.03 0.03 -0.03 -0.01 -0.03 0.19 0.15
salon 0.09 0.04 1.00 0.56 0.17 0.60 0.41 0.73 -0.08 0.43
drawingRoom 0.03 -0.03 0.56 1.00 0.22 0.50 0.37 0.66 -0.10 0.36
cocina 0.01 0.03 0.17 0.22 1.00 0.26 0.09 0.27 -0.11 0.08
cuartodebaño 0.08 -0.03 0.60 0.50 0.26 1.00 0.30 0.65 -0.06 0.40
ladderRatio 0.02 -0.01 0.41 0.37 0.09 0.30 1.00 0.42 -0.08 0.22
cuadrados1 0.08 -0.03 0.73 0.66 0.27 0.65 0.42 1.00 -0.18 0.52
precio1 0.19 0.19 -0.08 -0.10 -0.11 -0.06 -0.08 -0.18 1.00 0.74
totalPrice1 0.22 0.15 0.43 0.36 0.08 0.40 0.22 0.52 0.74 1.00
plot_correlation(numericas)

VEMOS QUE HAY VARIABLES QUE ESTÁN MUY CORRELACIONADAS ENTRE SÍ, Y MUY CORRELACIONADAS CON EL PRECIO TOTAL DE LA VIVIENDA:

  • El PRECIO TOTAL está correlacionado con los METROS CUADRADOS, el NÚMERO DE HABITACIONES y de BAÑOS, y muy correlacionada, claramente, con el PRECIO por metro cuadrado.

  • los METROS CUADRADOS, están correlacionados con el NÚMERO DE HABITACIONES en general, y por supuesto como ya hemos dicho, con el PRECIO TOTAL.

  • el NÚMERO DE HABITACIONES, SALONES Y BAÑOS está relacionado con el NÚMERO DE OTRAS ESTANCIAS, con LAS ESCALERAS que tiene y con el PRECIO TOTAL.

  • los DÍAS DE MERCADO,están correlacionados con la variable “SEGUIDORES”.

Selección de Variables Cuantitativas:

VAMOS A HACER UN ESTUDIO DE LA ESFERICIDAD DE BARLETT Y DEL KMO, PARA VER CÓMO ES LA CORRELACIÓN ENTRE LAS VARIABLES Y SI TENEMOS QUE TOMAR MEDIDAS ANTES DE EMPEZAR A MODELAR Y A APLICAR ALGORITMOS.

**DEJANDO LA VARIABLE OBJETIVO FUERA (totalprice) Y LA LONGITUD Y LATITUD.

**Vemos que hay correlación entre DOM y SEGUIDORES, pero como la variable DOM la vamos a eliminar del modelo por tener tantos valores iguales, Pues no metemos la variable “seguidores” en el estudio de la esfericidad. Y sí la tendremos en cuenta después para el modelo.

**Hacemos lo mismo con la variable precio m2, que al tener tanta correlación con la variable objetivo, no vamos a tenerla en cuenta para el modelo.

Así que, solamente vamos a ver si el resto de variables que tienen que ver con los metros cuadrados y el número de estancias, tienen la correlación suficiente para hacer con ellas variables nuevas mediante componentes principales, y así reducir dimensiones.

library(psych)
## 
## Attaching package: 'psych'
## The following object is masked from 'package:Hmisc':
## 
##     describe
## The following object is masked from 'package:car':
## 
##     logit
## The following object is masked from 'package:randomForest':
## 
##     outlier
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
## The following object is masked from 'package:dlookr':
## 
##     describe
cortest.bartlett(datos_limpios[,c(5,6,7,8,13,17)])
## R was not square, finding R from data
## $chisq
## [1] 17267.34
## 
## $p.value
## [1] 0
## 
## $df
## [1] 15

Vemos que el resultado del test es compatible con la existencia de correlacion suficiente para hacer componentes ppales p-value<0.05.

KMO(datos_limpios[,c(5,6,7,8,13,17)])
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = datos_limpios[, c(5, 6, 7, 8, 13, 17)])
## Overall MSA =  0.84
## MSA for each item = 
##        salon  drawingRoom       cocina cuartodebaño  ladderRatio   cuadrados1 
##         0.83         0.88         0.85         0.88         0.92         0.79

Vemos que la medida del KMO para todas las variables es superior a 0.5, así que podemos dejar todas y hacer combinaciones lineales entre ellas, para hallar variables nuevas y así reducir el número de variables.

APLICAMOS COMPONENTES PRINCIPALES

salon,drawingRoom ,cocina ,cuartodebaño,ladderRatio ,cuadrados1

datos_limpios2<-datos_limpios[, c(5 ,6, 7, 8, 13, 17)]
str(datos_limpios2)
## 'data.frame':    7455 obs. of  6 variables:
##  $ salon       : int  2 3 1 5 3 2 3 4 3 1 ...
##  $ drawingRoom : int  1 2 0 2 2 1 1 2 1 1 ...
##  $ cocina      : int  1 1 0 1 1 1 1 1 1 1 ...
##  $ cuartodebaño: int  1 2 0 3 1 1 1 2 1 1 ...
##  $ ladderRatio : num  0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
##  $ cuadrados1  : num  4.34 4.99 4.97 5.47 4.72 ...
limpios.pc <- princomp(datos_limpios2,cor=TRUE,scale=TRUE)
## Warning: In princomp.default(datos_limpios2, cor = TRUE, scale = TRUE) :
##  extra argument 'scale' will be disregarded
summary(limpios.pc,loadings=TRUE,scale=TRUE)
## Importance of components:
##                           Comp.1    Comp.2    Comp.3     Comp.4     Comp.5
## Standard deviation     1.7953291 0.9710155 0.8461141 0.70451923 0.61981260
## Proportion of Variance 0.5372011 0.1571452 0.1193182 0.08272456 0.06402794
## Cumulative Proportion  0.5372011 0.6943463 0.8136644 0.89638900 0.96041694
##                            Comp.6
## Standard deviation     0.48733804
## Proportion of Variance 0.03958306
## Cumulative Proportion  1.00000000
## 
## Loadings:
##              Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6
## salon         0.469  0.146  0.188  0.161  0.677  0.489
## drawingRoom   0.439               -0.800 -0.319  0.235
## cocina        0.202 -0.910 -0.341         0.104       
## cuartodebaño  0.439         0.319  0.557 -0.608  0.139
## ladderRatio   0.323  0.377 -0.846  0.153 -0.118       
## cuadrados1    0.499         0.147         0.213 -0.826

Con la primera componente explicamos el 54% de las variables elegidas. Pasando de 8 variables a tan solo 1. El resto de variables no incluídas en los componentes principales, las añadiremos si lo vemos conveniente en el modelo, tal y como hemos comentado antes. En principio, la variable “precio por metro cuadrado” no, ya que está muy correlacionada con la variable objetivo. Y tampoco la variable “DOM”. Además añadiremos todas las variables categóricas que nos sean explicativas significativamente.

plot(limpios.pc)

LA NUEVA VARIABLE SERÁ:

principales<-limpios.pc$scores[,1]
summary(principales)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -6.4954 -1.1525 -0.1893  0.0000  0.9348 11.6032

COMPONENTE1=PRINCIPALES será la variable combinación lineal de todas las cuantitativas: salon,drawingRoom ,cocina ,cuartodebaño,ladderRatio ,cuadrados1, QUE TIENEN QUE VER CON EL TAMAÑO DE LA VIVIENDA Y POR LO TANTO EL NÚMERO DE ESTANCIAS QUE TIENE.

Modelización:

Datos para los modelos:

**Variables:

PRINCIPALES–(combinación lineal de las variables: salon,drawingRoom ,cocina ,cuartodebaño,ladderRatio ,cuadrados1) LONGITUD Y LATITUD BUILDING_TYPE, BUILDING_STRUCTURE, RENOVACIONCONDICION, METRO, ASCENSOR, FLOOR y la variable objetivo “TOTALPRICE1”.

(Dejamos fuera del modelo: “precio” por metro2, y la variable “DOM” y también la variable “FIVEYEARSPROPERTY” y “BUILDING-STRUCTURE”)

library(stats)
datosFinal<-cbind(principales,datos_limpios[, c(1,2,4,9,10,11,12,14,16,19)])
head(datosFinal)
principales Lng Lat seguidores floor buildingType renovacionCondicion buildingStrucuture ascensor metro totalPrice1
-0.2322052 116.2324 40.23553 6.00 6 4 1 2 0 0 5.135798
2.9498822 116.2495 40.22179 4.00 7 4 4 2 0 0 5.886104
-2.6655683 116.5239 39.92328 3.00 32 1 3 6 1 1 6.152733
5.4828705 116.4300 40.06624 52.00 6 4 3 2 0 0 6.363028
1.7733238 116.5209 39.91885 122.46 6 4 2 2 0 1 5.799093
-0.3255857 116.2258 39.80226 122.46 6 3 2 1 0 1 5.298317

Variables de control de los modelos:

library(caret)


# TrainControl general con método de validación cruzada con 5 particiones por 1 repeticiones.

control <- trainControl(
                        method        = "repeatedcv", 
                        number        = 5,
                        repeats       = 1, 
                        returnResamp  = "final",
                        allowParallel = TRUE
                       )

#Como metrica utilizaremos RMSE en todos los casos.
metrica <- "RMSE"

Creación del fichero de entrenamiento y test para “precio total”:

# Creamos muestras de entrenamiento y de test (80% - 20%)

set.seed(100)
train_sample <- createDataPartition(y = datosFinal$totalPrice1, p = .8, list = FALSE)
train_prTotal    <- datosFinal[train_sample,] 
test_prTotal     <- datosFinal[-train_sample,]

#-- Save train/test precioTotal.
save(train_prTotal, test_prTotal, file = "traintest_prTotal.RData")

fichero de entrenamiento

summary(train_prTotal )
##   principales             Lng             Lat          seguidores   
##  Min.   :-6.495359   Min.   :116.1   Min.   :39.63   Min.   :  0.0  
##  1st Qu.:-1.164264   1st Qu.:116.3   1st Qu.:39.89   1st Qu.:  1.0  
##  Median :-0.191655   Median :116.4   Median :39.93   Median :  5.0  
##  Mean   : 0.004976   Mean   :116.4   Mean   :39.95   Mean   : 13.8  
##  3rd Qu.: 0.941452   3rd Qu.:116.5   3rd Qu.:39.99   3rd Qu.: 17.0  
##  Max.   :11.603205   Max.   :116.7   Max.   :40.25   Max.   :122.5  
##                                                                     
##      floor      buildingType renovacionCondicion buildingStrucuture ascensor
##  6      :1185   1:2023       1:1744              1:  85             0:1825  
##  22     : 434   2:  22       2: 155              2:1400             1:4141  
##  16     : 399   3:1504       3:1311              3:  61                     
##  18     : 354   4:2417       4:2756              4: 187                     
##  24     : 326                                    5:   5                     
##  21     : 321                                    6:4228                     
##  (Other):2947                                                               
##  metro     totalPrice1    
##  0:2387   Min.   :-2.303  
##  1:3579   1st Qu.: 5.323  
##           Median : 5.720  
##           Mean   : 5.711  
##           3rd Qu.: 6.098  
##           Max.   : 7.208  
## 

fichero de test

summary(test_prTotal )
##   principales            Lng             Lat          seguidores    
##  Min.   :-5.92735   Min.   :116.1   Min.   :39.63   Min.   :  0.00  
##  1st Qu.:-1.11750   1st Qu.:116.3   1st Qu.:39.89   1st Qu.:  1.00  
##  Median :-0.18591   Median :116.4   Median :39.93   Median :  5.00  
##  Mean   :-0.01994   Mean   :116.4   Mean   :39.94   Mean   : 13.78  
##  3rd Qu.: 0.92369   3rd Qu.:116.5   3rd Qu.:39.99   3rd Qu.: 16.00  
##  Max.   : 8.55499   Max.   :116.7   Max.   :40.25   Max.   :122.46  
##                                                                     
##      floor     buildingType renovacionCondicion buildingStrucuture ascensor
##  6      :312   1:459        1:442               1:  28             0: 471  
##  22     :111   2:  5        2: 32               2: 383             1:1018  
##  18     : 98   3:398        3:340               3:  12                     
##  24     : 83   4:627        4:675               4:  35                     
##  16     : 80                                    5:   0                     
##  21     : 78                                    6:1031                     
##  (Other):727                                                               
##  metro    totalPrice1    
##  0:626   Min.   :0.6931  
##  1:863   1st Qu.:5.3230  
##          Median :5.7203  
##          Mean   :5.7092  
##          3rd Qu.:6.0981  
##          Max.   :7.2079  
## 
clusterCPU <- makePSOCKcluster(detectCores() - 1)
registerDoParallel(clusterCPU)

REGRESIÓN LINEAL:

Vamos a probar a hacer una regresión lineal y ver qué resultados obtenemos.

modeloRegresion <- lm(totalPrice1 ~ ., data = datosFinal)
summary(modeloRegresion)
## 
## Call:
## lm(formula = totalPrice1 ~ ., data = datosFinal)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7.6429 -0.2619 -0.0037  0.2790  2.0031 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          74.0552375  6.8623671  10.792  < 2e-16 ***
## principales           0.1974464  0.0036950  53.436  < 2e-16 ***
## Lng                  -0.5749861  0.0518222 -11.095  < 2e-16 ***
## Lat                  -0.0324110  0.0667758  -0.485 0.627428    
## seguidores            0.0036525  0.0002722  13.419  < 2e-16 ***
## floor2               -0.6918317  0.1506171  -4.593 4.43e-06 ***
## floor3               -0.6467531  0.1276963  -5.065 4.19e-07 ***
## floor4               -0.6198636  0.1267793  -4.889 1.03e-06 ***
## floor5               -0.8124436  0.1121647  -7.243 4.82e-13 ***
## floor6               -0.7879408  0.1095450  -7.193 6.97e-13 ***
## floor7               -0.8352838  0.1160417  -7.198 6.70e-13 ***
## floor8               -0.7386626  0.1261341  -5.856 4.94e-09 ***
## floor9               -0.8269925  0.1173104  -7.050 1.96e-12 ***
## floor10              -0.8173447  0.1174847  -6.957 3.77e-12 ***
## floor11              -0.7726000  0.1158750  -6.668 2.79e-11 ***
## floor12              -0.7785369  0.1151124  -6.763 1.45e-11 ***
## floor13              -0.6707983  0.1213038  -5.530 3.31e-08 ***
## floor14              -0.7414551  0.1189377  -6.234 4.80e-10 ***
## floor15              -0.8136869  0.1162677  -6.998 2.82e-12 ***
## floor16              -0.5630323  0.1131745  -4.975 6.68e-07 ***
## floor17              -0.6894708  0.1203765  -5.728 1.06e-08 ***
## floor18              -0.7075051  0.1132245  -6.249 4.37e-10 ***
## floor19              -0.5005373  0.1321563  -3.787 0.000153 ***
## floor20              -0.8990264  0.1164722  -7.719 1.33e-14 ***
## floor21              -0.7093459  0.1139611  -6.224 5.10e-10 ***
## floor22              -0.7561527  0.1133081  -6.673 2.68e-11 ***
## floor23              -0.9847664  0.1230706  -8.002 1.42e-15 ***
## floor24              -0.8612335  0.1143063  -7.534 5.49e-14 ***
## floor25              -0.6784129  0.1184127  -5.729 1.05e-08 ***
## floor26              -0.6568068  0.1177255  -5.579 2.50e-08 ***
## floor27              -0.6769570  0.1166975  -5.801 6.87e-09 ***
## floor28              -0.6696878  0.1153781  -5.804 6.73e-09 ***
## floor29              -0.7671202  0.1258624  -6.095 1.15e-09 ***
## floor30              -0.6166576  0.1225569  -5.032 4.98e-07 ***
## floor31              -0.5203644  0.1310886  -3.970 7.27e-05 ***
## floor32              -0.3344728  0.1675879  -1.996 0.045992 *  
## floor33              -0.5163688  0.1833264  -2.817 0.004865 ** 
## floor34              -0.9119618  0.1220944  -7.469 8.98e-14 ***
## floor36              -0.8162887  0.3111657  -2.623 0.008725 ** 
## floor37              -0.8245558  0.2749860  -2.999 0.002722 ** 
## floor42              -0.0741378  0.2101404  -0.353 0.724247    
## buildingType2        -0.1707440  0.1141162  -1.496 0.134637    
## buildingType3        -0.0029696  0.0178143  -0.167 0.867613    
## buildingType4         0.0123432  0.0208234   0.593 0.553364    
## renovacionCondicion2  0.1117386  0.0390874   2.859 0.004266 ** 
## renovacionCondicion3  0.2588966  0.0170671  15.169  < 2e-16 ***
## renovacionCondicion4  0.2526873  0.0142648  17.714  < 2e-16 ***
## buildingStrucuture2   0.0441737  0.0590792   0.748 0.454663    
## buildingStrucuture3  -0.0392771  0.1078533  -0.364 0.715740    
## buildingStrucuture4   0.1951476  0.0670212   2.912 0.003605 ** 
## buildingStrucuture5  -0.2526393  0.2322415  -1.088 0.276705    
## buildingStrucuture6   0.1387514  0.0611327   2.270 0.023256 *  
## ascensor1             0.1749279  0.0280278   6.241 4.58e-10 ***
## metro1                0.2688686  0.0129532  20.757  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5019 on 7401 degrees of freedom
## Multiple R-squared:  0.4156, Adjusted R-squared:  0.4114 
## F-statistic:  99.3 on 53 and 7401 DF,  p-value: < 2.2e-16

Vemos que la variable “buildingType” no es nada significativa para el modelo. Aparte de algún factor de “floor”. Sin embargo el p-value del modelo sí es significativo, al igual que la mayoría de las variables. Pero solamente tiene un R2=41%. Con lo que el modelo es muy flojo.

MODELO LASSO:

set.seed(7)


#Control de la Técnica de Remuestreo: 100 muestras bootstrap

lasso.ctrl = trainControl( method = "boot" , number = 100)

lassoGrid = expand.grid( .alpha = 1 , .lambda = seq( .001 , .1 , length = 20 ))

modelo_lasso <- train(
                          totalPrice1 ~., 
                           data      = train_prTotal, 
                           method    = "glmnet", 
                           preProc   = c("center", "scale"), 
                           tuneGrid  = lassoGrid, 
                           metric    = metrica, 
                           trControl = lasso.ctrl
                          )

saveRDS(modelo_lasso, "mod_lasso.RDS")

MODELO CART:

set.seed(7)

cartGrid <- expand.grid(cp = 0:20/100)
modelo_cart <- train(
                          totalPrice1 ~.,
                          data      = train_prTotal,
                          method    = "rpart",
                          metric    = metrica,
                          preProc   = c("center", "scale"),
                          trControl = control,
                          tuneGrid  = cartGrid
                         )
## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.
saveRDS(modelo_cart, "mod_cart.RDS")

RANDOM FOREST:

set.seed(9)

  #tune_grid = NULL
  # control_oob <- trainControl(method = "oob", verboseIter = FALSE)
 
tune_grid = expand.grid(
                         mtry          = 11:14,
                         splitrule     = c("variance", "extratrees"),
                         min.node.size = 5
                        )

modelo_rf <- train( 
                          totalPrice1 ~., 
                           data = train_prTotal, 
                           # allowParallel = TRUE, 
                           #method        = "rf",  
                           method        = "ranger", 
                           metric        = "RMSE", 
                           trControl     = control, 
                           tuneGrid      = tune_grid,
                           importance    = 'impurity'
                          )
 
saveRDS(modelo_rf, "mod_rf.RDS")

MODELO KNN-VECINOS:

set.seed(7)



 knnGrid <- expand.grid(k = 5:15)
 modelo_knn <- train(
                         totalPrice1 ~.,
                         data      = train_prTotal,
                         method    = "knn",
                         preProc   = c("center", "scale"),
                         metric    = metrica,
                         trControl = control,
                         tuneGrid  = knnGrid
                        )
 saveRDS(modelo_knn, "mod_knn.RDS")

MODELO PERCEPTRÓN MULTICAPA:

#library(fastDummies)

# train1 < dummy_cols(train_prTotal, remove_first_dummy = TRUE)

# remove_selected_columns = TRUE

set.seed(7)


mlpGrid <- expand.grid(size = c(4:10), decay = c(0.1,0.9))
modelo_mlp<- train( 
                        totalPrice1 ~., 
                        data      = train_prTotal, 
                        method    = "nnet", 
                        metric    = metrica,  
                        preProc   = c("center", "scale"),
                        trControl = control,  
                        tuneGrid  = mlpGrid,
                        Linout=TRUE
                       )
## # weights:  551
## initial  value 164579.810120 
## iter  10 value 135484.124640
## iter  20 value 135010.253476
## final  value 135010.074366 
## converged
saveRDS(modelo_mlp, "mod_mlp.RDS")

MODELO MÁQUINA SOPORTE VECTORIAL:

# .sigma = c(1:10/100)

set.seed(7)

svmGrid <- expand.grid(
                        .C     = c(1, 1.5,2),
                        .sigma = c(0.1, 0.01)
                       )
modelo_svm <- train(
                         totalPrice1 ~.,
                         data      = train_prTotal,
                         method    = "svmRadial",
                         metric    = metrica,
                         preProc   = c("center", "scale"),
                         trControl = control,
                         tuneGrid  = svmGrid
                        )

saveRDS(modelo_svm, "mod_svm.RDS")

MODELO DE EMBOLSADO:

set.seed(7)


modelo_bag <- train(
                        totalPrice1~., 
                        data      = train_prTotal, 
                        method    = "treebag", 
                        metric    = metrica, 
                        preProc   = c("center", "scale"), 
                        trControl = control, verbose = FALSE
                       )

saveRDS(modelo_bag, "mod_bag.RDS")

MODELO AUMENTO DE GRADIENTE:

set.seed(7)



gbmGrid <- expand.grid(
                        n.trees           = c(300, 400, 500),
                        interaction.depth = c(12, 13, 14), 
                        shrinkage         = 0.1, 
                        n.minobsinnode    = 10
                      )

modelo_gbm <- train( 
                        totalPrice1 ~., 
                        data      = train_prTotal, 
                        method    = "gbm", 
                        metric    = metrica,  
                        preProc   = c("center", "scale"),
                        trControl = control,   
                        tuneGrid  = gbmGrid,
                        verbose   = FALSE
                       )


saveRDS(modelo_gbm, "mod_gbm.RDS")

AUMENTO DE GRADIENTE EXTREMO:

set.seed(7)


grid_xgbTree = expand.grid(
                            nrounds = 500,
                            eta = c(0.001, 0.3),
                            max_depth = c(6, 8),
                            gamma = c(1, 3), 
                            subsample = c(0.75, 1),
                            min_child_weight = c(2, 3), 
                            colsample_bytree = 1
                           )

modelo_xgb <- train( 
                        totalPrice1~., 
                        data      = train_prTotal,  
                        method    = "xgbTree", 
                        metric    = metrica,  
                        preProc   = c("center", "scale"),
                        trControl = control,   
                        tuneGrid  = grid_xgbTree
                       )

saveRDS(modelo_xgb, "mod_xgb.RDS")

Resultados de los Modelos:

## Funciones para sacar resultados de los modelos:


mod_lasso <- readRDS("mod_lasso.RDS")
mod_knn   <- readRDS("mod_knn.RDS")
mod_cart  <- readRDS("mod_cart.RDS")
mod_rf    <- readRDS("mod_rf.RDS")
mod_svm   <- readRDS("mod_svm.RDS")
mod_bag   <- readRDS("mod_bag.RDS")
mod_mlp   <- readRDS("mod_mlp.RDS")
mod_gbm   <- readRDS("mod_gbm.RDS")
mod_xgb   <- readRDS("mod_xgb.RDS")
maquetar <- function(x){
  ft <- flextable(data = x) %>%
            fontsize(size = 10, part = "body") %>% 
            fontsize(size = 12, part = "header")
  ft <- color(ft, color = "darkgreen", part = "header")
  return(autofit(ft))
}

Tablas y gráficos de los diferentes modelos:

Medidas_Modelo <- function(modelo) {
 
 #  train      = dummy_cols(train_prTotal, remove_selected_columns = TRUE)
 #  test       = dummy_cols(test_prTotal, remove_selected_columns = TRUE)
  
  
  pred.train           <- as.data.frame(predict(modelo, train_prTotal, type = "raw"))
  names(pred.train)    <- "Prediccion"
  pred.train           <- cbind.data.frame(pred.train, Respuesta = train_prTotal$totalPrice1)
  R2.train             <- R2(pred.train$Prediccion, pred.train$Respuesta)
  RMSE.train           <- RMSE(pred.train$Prediccion, pred.train$Respuesta)
  MAE.train            <- MAE(pred.train$Prediccion, pred.train$Respuesta)

  pred.test            <- as.data.frame(predict(modelo, test_prTotal, type = "raw"))
  names(pred.test)     <- "Prediccion"
  pred.test            <- cbind.data.frame(pred.test, Respuesta = test_prTotal$totalPrice1)
  R2.test              <- R2(pred.test$Prediccion, pred.test$Respuesta)
  RMSE.test            <- RMSE(pred.test$Prediccion, pred.test$Respuesta)
  MAE.test             <- MAE(pred.test$Prediccion, pred.test$Respuesta)
  
  Muestra <- c("Entrenamiento", "Test")
  R2      <- c(R2.train,  R2.test)
  RMSE    <- c(RMSE.train,  RMSE.test)
  MAE     <- c(MAE.train,  MAE.test)
  
  resul <- data.frame(Muestra, R2, RMSE, MAE)
  maquetar(resul)
}

MODELO LASSO:

maquetar(mod_lasso$results %>% arrange(-Rsquared) %>% head(10)) %>% add_header_lines(values = "Resultados entrenamiento del modelo de Regresión Lineal Lasso ordenados según valor del R2")

Resultados entrenamiento del modelo de Regresión Lineal Lasso ordenados según valor del R2

alpha

lambda

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

1

0.001000000

0.4993248

0.4152112

0.3388996

0.03513218

0.03189000

0.006493007

1

0.006210526

0.4997609

0.4143825

0.3392441

0.03565302

0.03258271

0.006769806

1

0.011421053

0.5017238

0.4110378

0.3411917

0.03600311

0.03318718

0.007027130

1

0.016631579

0.5045546

0.4061368

0.3442145

0.03627415

0.03378447

0.007266586

1

0.021842105

0.5078809

0.4002939

0.3477444

0.03649792

0.03439626

0.007457360

1

0.027052632

0.5114221

0.3940568

0.3513348

0.03667446

0.03502549

0.007612157

1

0.032263158

0.5149845

0.3878727

0.3547608

0.03678377

0.03552184

0.007743418

1

0.037473684

0.5186156

0.3815597

0.3581528

0.03692904

0.03623113

0.007935090

1

0.042684211

0.5225472

0.3743250

0.3617627

0.03703944

0.03695907

0.008124370

1

0.047894737

0.5267318

0.3661602

0.3655924

0.03700732

0.03735029

0.008217313

Medidas_Modelo(mod_lasso)

Muestra

R2

RMSE

MAE

Entrenamiento

0.4173322

0.5029964

0.3353615

Test

0.3892215

0.4961776

0.3428753

plot(mod_lasso)

plot(varImp(mod_lasso))

Para este modelo LASSO, vemos que las tres variables más importantes son: principales(es decir, el tamaño y espacios de la casa), la reforma de la casa y el que haya metro cerca.

MODELO KNN-VECINOS

maquetar(mod_knn$results %>% arrange(-Rsquared) %>% head(10)) %>% 
  add_header_lines(values = "Resultados entrenamiento del modelo de K-vecinos ordenados según valor del R2")

Resultados entrenamiento del modelo de K-vecinos ordenados según valor del R2

k

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

5

0.4937760

0.4471970

0.3196267

0.03029263

0.03074979

0.002725247

6

0.4955760

0.4405962

0.3224960

0.02543760

0.02151814

0.003159644

7

0.4970020

0.4347546

0.3245156

0.02734541

0.02149558

0.002806645

8

0.4963537

0.4347011

0.3255765

0.02884137

0.01964448

0.003314983

9

0.4992322

0.4273171

0.3289378

0.02793539

0.01600812

0.001842945

10

0.5027428

0.4190159

0.3323192

0.02796860

0.01858243

0.001654314

11

0.5049303

0.4133066

0.3353511

0.03120082

0.02362663

0.004025109

12

0.5067954

0.4089184

0.3370982

0.03154396

0.02477185

0.004622579

13

0.5077413

0.4067148

0.3390172

0.03317208

0.02581856

0.004917618

14

0.5092265

0.4030373

0.3405741

0.03307159

0.02386850

0.004296971

Medidas_Modelo(mod_knn)

Muestra

R2

RMSE

MAE

Entrenamiento

0.6332068

0.3992943

0.2490379

Test

0.4348650

0.4862377

0.3171707

`

plot(mod_knn)

plot(varImp(mod_knn))

Para el modelo KNN-VECINOS al igual que en el modelo lasso, da más importancia al tamaño y número de estancias, a la reforma que tenga hecha y a que tenga servicio de metro cerca.

MODELO CART

maquetar(mod_cart$results %>% arrange(-Rsquared) %>% head(10)) %>% 
  add_header_lines(values = "Resultados entrenamiento del modelo CART ordenados según valor del R2")

Resultados entrenamiento del modelo CART ordenados según valor del R2

cp

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

0.00

0.4561176

0.5330699

0.2835052

0.04399257

0.05132304

0.011639833

0.01

0.5220056

0.3732680

0.3573564

0.03907737

0.03746859

0.007837437

0.02

0.5540084

0.2928330

0.3801575

0.03602913

0.02250630

0.007489522

0.03

0.5855333

0.2104763

0.4114109

0.03380901

0.02316808

0.010723533

0.04

0.5889801

0.2012054

0.4148332

0.03547360

0.02037062

0.008066666

0.05

0.5939341

0.1878419

0.4198816

0.04042912

0.04400858

0.012286341

0.06

0.5939341

0.1878419

0.4198816

0.04042912

0.04400858

0.012286341

0.07

0.6098465

0.1433755

0.4370132

0.03690136

0.02177196

0.008017033

0.08

0.6098465

0.1433755

0.4370132

0.03690136

0.02177196

0.008017033

0.09

0.6098465

0.1433755

0.4370132

0.03690136

0.02177196

0.008017033

Medidas_Modelo(mod_cart)

Muestra

R2

RMSE

MAE

Entrenamiento

0.7109685

0.3542543

0.2069465

Test

0.5612421

0.4256306

0.2805067

plot(mod_cart)

plot(varImp(mod_cart))

El modelo CART da más importancia a las variables: tamaño y número de estancias, a la situación del inmueble en la ciudad y al número de seguidores.

RANDOM FOREST

maquetar(mod_rf$results %>% arrange(-Rsquared) %>% head(10)) %>% 
  add_header_lines(values = "Resultados entrenamiento del modelo Random Forest ordenados según valor del R2")

Resultados entrenamiento del modelo Random Forest ordenados según valor del R2

mtry

splitrule

min.node.size

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

14

variance

5

0.3932020

0.6504825

0.2351972

0.02860972

0.04007672

0.008452444

13

variance

5

0.3948012

0.6484374

0.2370153

0.02798121

0.03938204

0.008192287

12

variance

5

0.3964389

0.6474424

0.2386585

0.02827250

0.04014519

0.008202766

11

variance

5

0.3987860

0.6449262

0.2410152

0.02653840

0.03708779

0.008102723

14

extratrees

5

0.4300250

0.5885064

0.2678760

0.02048415

0.02068966

0.007709120

13

extratrees

5

0.4325538

0.5853444

0.2702101

0.02060142

0.02003163

0.008160807

12

extratrees

5

0.4362643

0.5806498

0.2734250

0.02008255

0.01938413

0.007792220

11

extratrees

5

0.4412765

0.5735376

0.2777879

0.02030082

0.02014833

0.007909555

Medidas_Modelo(mod_rf)

Muestra

R2

RMSE

MAE

Entrenamiento

0.8823996

0.2426708

0.1340852

Test

0.6432954

0.3804311

0.2379775

RESULTADOS E HIPERPARÁMETROS DEL MODELO CON R2=65%

mod_rf$finalModel
## Ranger result
## 
## Call:
##  ranger::ranger(dependent.variable.name = ".outcome", data = x,      mtry = min(param$mtry, ncol(x)), min.node.size = param$min.node.size,      splitrule = as.character(param$splitrule), write.forest = TRUE,      probability = classProbs, ...) 
## 
## Type:                             Regression 
## Number of trees:                  500 
## Sample size:                      5966 
## Number of independent variables:  53 
## Mtry:                             14 
## Target node size:                 5 
## Variable importance mode:         impurity 
## Splitrule:                        variance 
## OOB prediction error (MSE):       0.1521239 
## R squared (OOB):                  0.6497003
plot(mod_rf)

plot(varImp(mod_rf))

El modelo RANDOM FOREST da más importancia a las variables: principales(tamaño y número de estancias del inmueble), a la situación geográfica dentro de la ciudad de Beijing, al número de seguidores y a que haya servicio de metro cerca del inmueble.

MODELO MÁQUINAS DE SOPORTE VECTORIAL

maquetar(mod_svm$results %>% arrange(-Rsquared) %>% head(10)) %>% 
  add_header_lines(values = "Resultados entrenamiento del modelo Máquinas de Vectores Soporte ordenados según valor del R2")

Resultados entrenamiento del modelo Máquinas de Vectores Soporte ordenados según valor del R2

C

sigma

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

2.0

0.10

0.4488151

0.5363971

0.2667384

0.04237853

0.04117015

0.006795660

1.5

0.10

0.4498158

0.5345713

0.2679389

0.04187981

0.04017561

0.006781833

1.0

0.10

0.4527399

0.5298855

0.2711416

0.04091518

0.03787308

0.005951516

2.0

0.01

0.4529488

0.5280882

0.2750574

0.04037004

0.03683115

0.004858022

1.5

0.01

0.4555294

0.5229625

0.2778219

0.03992412

0.03579304

0.004355122

1.0

0.01

0.4598989

0.5143335

0.2830447

0.03987796

0.03553324

0.004171472

Medidas_Modelo(mod_svm)

Muestra

R2

RMSE

MAE

Entrenamiento

0.6766302

0.3765752

0.1781236

Test

0.5532377

0.4241203

0.2612098

RESULTADOS E HIPERPARÁMETROS DEL MODELO CON ERROR PRECDICTIVO DE 33%

mod_svm$finalModel
## Support Vector Machine object of class "ksvm" 
## 
## SV type: eps-svr  (regression) 
##  parameter : epsilon = 0.1  cost C = 2 
## 
## Gaussian Radial Basis kernel function. 
##  Hyperparameter : sigma =  0.1 
## 
## Number of Support Vectors : 4803 
## 
## Objective Function Value : -2771.687 
## Training error : 0.326547
plot(mod_svm)

plot(varImp(mod_svm))

En el modelo MÁQUINAS DE SOPORTE VECTORIAL las variables más importantes son: principales(el tamaño y número de estancias del inmueble), la reforma que tenga hecho el piso y si el metro está cerca del piso.

MODELO PERCEPTRÓN MULTICAPA

maquetar(mod_mlp$results %>% arrange(-Rsquared) %>% head(10)) %>% 
  add_header_lines(values = "Resultados entrenamiento del modelo Perceptrón Multicapa ordenados según valor del R2")

Resultados entrenamiento del modelo Perceptrón Multicapa ordenados según valor del R2

size

decay

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

6

0.9

4.757117

0.3908378

4.717909

0.008580517

0.03119418

0.01037696

5

0.9

4.757125

0.3902153

4.717917

0.008580456

0.03053710

0.01037710

4

0.1

4.757038

0.3839220

4.717829

0.008580438

0.03155649

0.01037709

5

0.1

4.757037

0.3806719

4.717827

0.008580377

0.04028502

0.01037702

7

0.1

4.757035

0.3792481

4.717826

0.008580344

0.02402229

0.01037701

9

0.1

4.757034

0.3790672

4.717824

0.008580405

0.02251608

0.01037705

8

0.1

4.757034

0.3788273

4.717825

0.008580375

0.03796687

0.01037704

8

0.9

4.757107

0.3689443

4.717899

0.008580359

0.05964617

0.01037705

10

0.1

4.757033

0.3643443

4.717824

0.008580324

0.03550024

0.01037698

7

0.9

4.757112

0.3574689

4.717904

0.008580208

0.04422170

0.01037664

Medidas_Modelo(mod_mlp)

Muestra

R2

RMSE

MAE

Entrenamiento

0.3801551

4.757038

4.717822

Test

0.3527930

4.751760

4.710050

plot(mod_mlp)

plot(varImp(mod_mlp))

En el modelo PERCEPTRÓN MULTICAPA las variables más relevantes son: principales(tamaño y número de estancias), el metro cerca y reforma y seguidores.

MODELO AUMENTO DE GRADIENTE

maquetar(mod_gbm$results %>% arrange(-Rsquared) %>% head(10)) %>% 
  add_header_lines(values = "Resultados entrenamiento del modelo GBM ordenados según valor del R2")

Resultados entrenamiento del modelo GBM ordenados según valor del R2

shrinkage

interaction.depth

n.minobsinnode

n.trees

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

0.1

14

10

300

0.4022086

0.6307544

0.2399222

0.03607888

0.05578952

0.008131146

0.1

13

10

300

0.4038943

0.6279104

0.2403791

0.03577380

0.05316905

0.005568673

0.1

12

10

300

0.4047602

0.6265868

0.2399381

0.02903291

0.04676432

0.003149363

0.1

14

10

400

0.4081402

0.6226050

0.2409595

0.03575345

0.06150495

0.007425353

0.1

13

10

400

0.4078785

0.6225817

0.2404372

0.03398930

0.05380105

0.004354197

0.1

12

10

400

0.4088836

0.6208225

0.2405801

0.02755276

0.04995060

0.002851929

0.1

14

10

500

0.4116312

0.6192628

0.2410421

0.03561018

0.06451432

0.005552533

0.1

12

10

500

0.4125284

0.6169301

0.2417431

0.02908956

0.05432339

0.002657209

0.1

13

10

500

0.4130165

0.6156390

0.2407183

0.03431049

0.05799830

0.004328114

Medidas_Modelo(mod_gbm)

Muestra

R2

RMSE

MAE

Entrenamiento

0.8219256

0.2804709

0.1852340

Test

0.6013434

0.4039350

0.2474449

plot(mod_gbm)

plot(varImp(mod_gbm))

En el modelo AUMENTO DE GRADIENTE las variables más importantes son: principales(tamaño y número de estancias), la situación geográfica del inmueble en la ciudad y los seguidores.

MODELO AUMENTO DE GRADIENTE EXTREMO

maquetar(mod_xgb$results %>% arrange(-Rsquared) %>% head(10)) %>% 
  add_header_lines(values = "Resultados entrenamiento del modelo XGB ordenados según valor del R2")

Resultados entrenamiento del modelo XGB ordenados según valor del R2

eta

max_depth

gamma

colsample_bytree

min_child_weight

subsample

nrounds

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

0.3

8

1

1

2

1.00

500

0.4122358

0.6099110

0.2525488

0.03416937

0.05472612

0.007313299

0.3

8

1

1

3

1.00

500

0.4121747

0.6097138

0.2520889

0.04140987

0.06059322

0.007518847

0.3

6

1

1

3

1.00

500

0.4135047

0.6067401

0.2527841

0.04405770

0.05598636

0.006866601

0.3

6

1

1

2

1.00

500

0.4193739

0.5967460

0.2543866

0.03630842

0.05421955

0.005439417

0.3

8

3

1

3

0.75

500

0.4234210

0.5948196

0.2562851

0.03155838

0.06281631

0.007175733

0.3

8

3

1

3

1.00

500

0.4249588

0.5862453

0.2692465

0.03379610

0.05152758

0.006670986

0.3

8

3

1

2

1.00

500

0.4247086

0.5861229

0.2668284

0.03354527

0.05190519

0.008281536

0.3

6

3

1

3

0.75

500

0.4290521

0.5837679

0.2594351

0.03030656

0.05739600

0.006121072

0.3

6

3

1

2

1.00

500

0.4266926

0.5833222

0.2661418

0.04066953

0.05304475

0.006987707

0.3

6

1

1

3

0.75

500

0.4338962

0.5832734

0.2532040

0.03362825

0.06234123

0.006437656

Medidas_Modelo(mod_xgb)

Muestra

R2

RMSE

MAE

Entrenamiento

0.7878063

0.3061438

0.2076107

Test

0.6102840

0.3971433

0.2516091

plot(mod_xgb)

plot(varImp(mod_xgb))

En el modelo AUMENTO DE GRADIENTE EXTREMO las variables más importantes son: principales(tamaño y número de estancias), la situación geográfica del inmueble en la ciudad y los seguidores.

MODELO DE EMBOLSADO

maquetar(mod_bag$results %>% arrange(-Rsquared) %>% head(10)) %>% 
  add_header_lines(values = "Resultados entrenamiento del modelo Bagging ordenados según valor del R2")

Resultados entrenamiento del modelo Bagging ordenados según valor del R2

parameter

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

none

0.4861056

0.4677843

0.3246993

0.03798871

0.032677

0.007437739

Medidas_Modelo(mod_bag)

Muestra

R2

RMSE

MAE

Entrenamiento

0.4866879

0.4779342

0.3237993

Test

0.4576539

0.4700950

0.3299333

plot(varImp(mod_bag))

En el método de EMBOLSADO las variables más importantes son: la situación geográfica del inmueble, el tamaño y número de estancias del piso y el número de seguidores en la página.

Contrastación y comparación de modelos

Puede verse que, todos los modelos, consiguen más predicciones correctas en el conjunto de entrenamiento que en el de test.

resultados<- resamples(
    list(
         
         CART = modelo_cart, 
         KNN = modelo_knn, 
         RED_NEURONAL = modelo_mlp, 
         SVM = modelo_svm,
         RF = modelo_rf,  
         GBM = modelo_gbm,
         BAG = modelo_bag,
         XGB = modelo_xgb
        )
    )

summary(resultados)
## 
## Call:
## summary.resamples(object = resultados)
## 
## Models: CART, KNN, RED_NEURONAL, SVM, RF, GBM, BAG, XGB 
## Number of resamples: 5 
## 
## MAE 
##                   Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
## CART         0.2676430 0.2777558 0.2827347 0.2835052 0.2929360 0.2964568    0
## KNN          0.3167844 0.3180781 0.3184006 0.3196267 0.3214475 0.3234231    0
## RED_NEURONAL 4.7062768 4.7109202 4.7146379 4.7178240 4.7269846 4.7303003    0
## SVM          0.2552670 0.2675375 0.2680664 0.2667384 0.2695301 0.2732909    0
## RF           0.2243935 0.2325053 0.2339814 0.2351972 0.2374479 0.2476578    0
## GBM          0.2332825 0.2352414 0.2364807 0.2399222 0.2410718 0.2535347    0
## BAG          0.3161005 0.3180499 0.3263039 0.3246993 0.3295874 0.3334547    0
## XGB          0.2431158 0.2449467 0.2559028 0.2520889 0.2567571 0.2597222    0
## 
## RMSE 
##                   Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
## CART         0.3831595 0.4576083 0.4667851 0.4561176 0.4714483 0.5015869    0
## KNN          0.4463051 0.4823160 0.5053507 0.4937760 0.5135499 0.5213581    0
## RED_NEURONAL 4.7478812 4.7515752 4.7535848 4.7570333 4.7643329 4.7677925    0
## SVM          0.3741546 0.4601022 0.4623475 0.4488151 0.4683979 0.4790732    0
## RF           0.3567157 0.3802024 0.3947192 0.3932020 0.3995650 0.4348077    0
## GBM          0.3687649 0.3698589 0.3987087 0.4022086 0.4191249 0.4545856    0
## BAG          0.4194034 0.4958835 0.4971132 0.4861056 0.5039437 0.5141842    0
## XGB          0.3605979 0.3881667 0.4068838 0.4121747 0.4398817 0.4653432    0
## 
## Rsquared 
##                   Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
## CART         0.4638140 0.5230905 0.5322916 0.5330699 0.5381585 0.6079949    0
## KNN          0.4176744 0.4185847 0.4469550 0.4471970 0.4624577 0.4903132    0
## RED_NEURONAL 0.3165308 0.3407792 0.3704442 0.3643443 0.3929993 0.4009682    0
## SVM          0.5003784 0.5167450 0.5263732 0.5363971 0.5315747 0.6069141    0
## RF           0.5963940 0.6331227 0.6535201 0.6504825 0.6640914 0.7052841    0
## GBM          0.5502752 0.6080301 0.6411983 0.6307544 0.6542720 0.6999963    0
## BAG          0.4339043 0.4519622 0.4590398 0.4677843 0.4736784 0.5203366    0
## XGB          0.5265524 0.5665798 0.6400033 0.6097138 0.6438644 0.6715692    0

EL MODELO QUE DA MEJORES RESULTADOS ES EL RANDOM FOREST CON UN MÁXIMO R2=0.71, Y EL PEOR MODELO ES LA RED NEURONAL CON UN MÁXIMO R2=0.40

dotplot(resultados, scales = list(relation = "free"))

EN LA GRÁFICA SE COMPRUEBA LO QUE HEMOS AFIRMADO HACE UN MOMENTO, EL MODELO RANDOM FOREST ES EL QUE MEJOR AJUSTA, MUY SEGUIDO DEL MODELO DE AUMENTO DE GRADIENTE. Y EL PEOR MODELO EL DE LA RED NEURONAL.

A CONTINUACIÓN VEMOS LAS DIFERENCIAS MÉTRICAS ENTRE LOS DISTINTOS MÉTODOS UTILIZADOS:

diferencias <- diff(resultados)

summary(diferencias)
## 
## Call:
## summary.diff.resamples(object = diferencias)
## 
## p-value adjustment: bonferroni 
## Upper diagonal: estimates of the difference
## Lower diagonal: p-value for H0: difference = 0
## 
## MAE 
##              CART      KNN       RED_NEURONAL SVM       RF        GBM      
## CART                   -0.036121 -4.434319     0.016767  0.048308  0.043583
## KNN          0.0542600           -4.398197     0.052888  0.084430  0.079705
## RED_NEURONAL 2.324e-09 4.627e-10               4.451086  4.482627  4.477902
## SVM          0.3474392 0.0012058 7.570e-10               0.031541  0.026816
## RF           0.0561362 0.0002252 1.522e-09    0.1051787           -0.004725
## GBM          0.0034458 0.0005038 9.824e-10    0.0598131 1.0000000          
## BAG          0.0472050 1.0000000 6.657e-10    0.0005211 0.0030424 0.0031778
## XGB          0.0212242 0.0003773 1.553e-09    0.3703976 0.2149967 0.1908072
##              BAG       XGB      
## CART         -0.041194  0.031416
## KNN          -0.005073  0.067538
## RED_NEURONAL  4.393125  4.465735
## SVM          -0.057961  0.014649
## RF           -0.089502 -0.016892
## GBM          -0.084777 -0.012167
## BAG                     0.072610
## XGB          0.0031303          
## 
## RMSE 
##              CART      KNN       RED_NEURONAL SVM       RF        GBM      
## CART                   -0.037658 -4.300916     0.007303  0.062916  0.053909
## KNN          0.560982            -4.263257     0.044961  0.100574  0.091567
## RED_NEURONAL 1.247e-07 3.709e-08               4.308218  4.363831  4.354825
## SVM          1.000000  0.265305  1.022e-07               0.055613  0.046606
## RF           1.000000  0.432684  6.019e-09    1.000000            -0.009007
## GBM          0.600247  0.012404  5.608e-08    1.000000  1.000000           
## BAG          0.498475  1.000000  7.179e-08    0.001356  0.848278  0.183762 
## XGB          0.646161  0.012370  1.011e-07    1.000000  1.000000  1.000000 
##              BAG       XGB      
## CART         -0.029988  0.043943
## KNN           0.007670  0.081601
## RED_NEURONAL  4.270928  4.344859
## SVM          -0.037291  0.036640
## RF           -0.092904 -0.018973
## GBM          -0.083897 -0.009966
## BAG                     0.073931
## XGB          0.190190           
## 
## Rsquared 
##              CART     KNN       RED_NEURONAL SVM       RF        GBM      
## CART                   0.085873  0.168726    -0.003327 -0.117413 -0.097685
## KNN          0.441574            0.082853    -0.089200 -0.203285 -0.183557
## RED_NEURONAL 0.171179 0.432542               -0.172053 -0.286138 -0.266410
## SVM          1.000000 0.252512  0.069048               -0.114085 -0.094357
## RF           1.000000 0.042304  0.006403     0.824325             0.019728
## GBM          0.451379 0.005421  0.023420     0.849945  1.000000           
## BAG          0.391866 1.000000  0.220747     0.003857  0.110369  0.091765 
## XGB          0.780713 0.012693  0.055047     1.000000  1.000000  1.000000 
##              BAG       XGB      
## CART          0.065286 -0.076644
## KNN          -0.020587 -0.162517
## RED_NEURONAL -0.103440 -0.245369
## SVM           0.068613 -0.073317
## RF            0.182698  0.040769
## GBM           0.162970  0.021041
## BAG                    -0.141930
## XGB          0.148923

Las mayores diferencias se dan entre RANDOM FOREST y REDES NEURONALES como cabía esperar por sus respectivos resultados.

tabla_resultados<-resultados$values %>% head(10)
kable(tabla_resultados)
Resample CART~MAE CART~RMSE CART~Rsquared KNN~MAE KNN~RMSE KNN~Rsquared RED_NEURONAL~MAE RED_NEURONAL~RMSE RED_NEURONAL~Rsquared SVM~MAE SVM~RMSE SVM~Rsquared RF~MAE RF~RMSE RF~Rsquared GBM~MAE GBM~RMSE GBM~Rsquared BAG~MAE BAG~RMSE BAG~Rsquared XGB~MAE XGB~RMSE XGB~Rsquared
Fold1.Rep1 0.2777558 0.4576083 0.5381585 0.3234231 0.5135499 0.4185847 4.706277 4.747881 0.3929993 0.2680664 0.4601022 0.5263732 0.2476578 0.3995650 0.6331227 0.2364807 0.4191249 0.6080301 0.3263039 0.4958835 0.4590398 0.2559028 0.4398817 0.5665798
Fold2.Rep1 0.2676430 0.3831595 0.6079949 0.3167844 0.4463051 0.4624577 4.730300 4.767792 0.3407792 0.2552670 0.3741546 0.6069141 0.2339814 0.4348077 0.5963940 0.2332825 0.3687649 0.6411983 0.3161005 0.4194034 0.5203366 0.2431158 0.3605979 0.6438644
Fold3.Rep1 0.2827347 0.4667851 0.5322916 0.3180781 0.5053507 0.4469550 4.726985 4.764333 0.3165308 0.2732909 0.4790732 0.5003784 0.2243935 0.3947192 0.6640914 0.2352414 0.3987087 0.6542720 0.3334547 0.5141842 0.4339043 0.2449467 0.4068838 0.6400033
Fold4.Rep1 0.2929360 0.4714483 0.5230905 0.3184006 0.4823160 0.4903132 4.710920 4.753585 0.4009682 0.2675375 0.4623475 0.5315747 0.2325053 0.3802024 0.6535201 0.2410718 0.3698589 0.6999963 0.3295874 0.4971132 0.4736784 0.2567571 0.3881667 0.6715692
Fold5.Rep1 0.2964568 0.5015869 0.4638140 0.3214475 0.5213581 0.4176744 4.714638 4.751575 0.3704442 0.2695301 0.4683979 0.5167450 0.2374479 0.3567157 0.7052841 0.2535347 0.4545856 0.5502752 0.3180499 0.5039437 0.4519622 0.2597222 0.4653432 0.5265524
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ readr     2.1.4
## ✔ lubridate 1.9.2     ✔ stringr   1.5.0
## ✔ purrr     1.0.1     ✔ tidyr     1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%()                   masks ggplot2::%+%()
## ✖ purrr::accumulate()            masks foreach::accumulate()
## ✖ tidytable::across()            masks dplyr::across()
## ✖ tidytable::add_count()         masks dplyr::add_count()
## ✖ tidytable::add_tally()         masks dplyr::add_tally()
## ✖ psych::alpha()                 masks ggplot2::alpha()
## ✖ tidytable::anti_join()         masks dplyr::anti_join()
## ✖ tidytable::arrange()           masks dplyr::arrange()
## ✖ tidytable::between()           masks data.table::between(), dplyr::between()
## ✖ tidytable::bind_cols()         masks dplyr::bind_cols()
## ✖ tidytable::bind_rows()         masks dplyr::bind_rows()
## ✖ tidytable::c_across()          masks dplyr::c_across()
## ✖ tidytable::case_match()        masks dplyr::case_match()
## ✖ tidytable::case_when()         masks dplyr::case_when()
## ✖ tidytable::coalesce()          masks dplyr::coalesce()
## ✖ randomForest::combine()        masks dplyr::combine()
## ✖ tidyr::complete()              masks mice::complete(), tidytable::complete()
## ✖ purrr::compose()               masks flextable::compose()
## ✖ tidytable::consecutive_id()    masks dplyr::consecutive_id()
## ✖ tidytable::count()             masks dplyr::count()
## ✖ tidytable::cross_join()        masks dplyr::cross_join()
## ✖ tidyr::crossing()              masks tidytable::crossing()
## ✖ tidytable::cume_dist()         masks dplyr::cume_dist()
## ✖ tidytable::cur_column()        masks dplyr::cur_column()
## ✖ tidytable::cur_data()          masks dplyr::cur_data()
## ✖ tidytable::cur_group_id()      masks dplyr::cur_group_id()
## ✖ tidytable::cur_group_rows()    masks dplyr::cur_group_rows()
## ✖ tidytable::dense_rank()        masks dplyr::dense_rank()
## ✖ tidytable::desc()              masks dplyr::desc()
## ✖ tidytable::distinct()          masks dplyr::distinct()
## ✖ tidyr::drop_na()               masks tidytable::drop_na()
## ✖ tibble::enframe()              masks tidytable::enframe()
## ✖ tidyr::expand()                masks tidytable::expand()
## ✖ tidyr::expand_grid()           masks tidytable::expand_grid()
## ✖ DALEX::explain()               masks dplyr::explain()
## ✖ tidyr::extract()               masks tidytable::extract(), dlookr::extract()
## ✖ tidyr::fill()                  masks tidytable::fill()
## ✖ mice::filter()                 masks tidytable::filter(), dplyr::filter(), stats::filter()
## ✖ xts::first()                   masks tidytable::first(), data.table::first(), dplyr::first()
## ✖ tidytable::full_join()         masks dplyr::full_join()
## ✖ tidytable::group_by()          masks dplyr::group_by()
## ✖ tidytable::group_cols()        masks dplyr::group_cols()
## ✖ dplyr::group_rows()            masks kableExtra::group_rows()
## ✖ tidytable::group_split()       masks dplyr::group_split()
## ✖ tidytable::group_vars()        masks dplyr::group_vars()
## ✖ lubridate::hour()              masks data.table::hour()
## ✖ tidytable::if_all()            masks dplyr::if_all()
## ✖ tidytable::if_any()            masks dplyr::if_any()
## ✖ tidytable::if_else()           masks dplyr::if_else()
## ✖ tidytable::inner_join()        masks dplyr::inner_join()
## ✖ tidytable::is_grouped_df()     masks dplyr::is_grouped_df()
## ✖ lubridate::isoweek()           masks data.table::isoweek()
## ✖ tidytable::lag()               masks dplyr::lag(), stats::lag()
## ✖ xts::last()                    masks tidytable::last(), data.table::last(), dplyr::last()
## ✖ tidytable::lead()              masks dplyr::lead()
## ✖ tidytable::left_join()         masks dplyr::left_join()
## ✖ purrr::lift()                  masks caret::lift()
## ✖ purrr::map()                   masks tidytable::map()
## ✖ purrr::map_chr()               masks tidytable::map_chr()
## ✖ purrr::map_dbl()               masks tidytable::map_dbl()
## ✖ purrr::map_df()                masks tidytable::map_df()
## ✖ purrr::map_dfc()               masks tidytable::map_dfc()
## ✖ purrr::map_dfr()               masks tidytable::map_dfr()
## ✖ purrr::map_int()               masks tidytable::map_int()
## ✖ purrr::map_lgl()               masks tidytable::map_lgl()
## ✖ purrr::map_vec()               masks tidytable::map_vec()
## ✖ purrr::map2()                  masks tidytable::map2()
## ✖ purrr::map2_chr()              masks tidytable::map2_chr()
## ✖ purrr::map2_dbl()              masks tidytable::map2_dbl()
## ✖ purrr::map2_df()               masks tidytable::map2_df()
## ✖ purrr::map2_dfc()              masks tidytable::map2_dfc()
## ✖ purrr::map2_dfr()              masks tidytable::map2_dfr()
## ✖ purrr::map2_int()              masks tidytable::map2_int()
## ✖ purrr::map2_lgl()              masks tidytable::map2_lgl()
## ✖ purrr::map2_vec()              masks tidytable::map2_vec()
## ✖ randomForest::margin()         masks ggplot2::margin()
## ✖ lubridate::mday()              masks data.table::mday()
## ✖ tidytable::min_rank()          masks dplyr::min_rank()
## ✖ lubridate::minute()            masks data.table::minute()
## ✖ lubridate::month()             masks data.table::month()
## ✖ tidytable::mutate()            masks dplyr::mutate()
## ✖ tidytable::n()                 masks dplyr::n()
## ✖ tidytable::n_distinct()        masks dplyr::n_distinct()
## ✖ tidytable::na_if()             masks dplyr::na_if()
## ✖ tidyr::nest()                  masks tidytable::nest()
## ✖ tidytable::nest_by()           masks dplyr::nest_by()
## ✖ tidytable::nest_join()         masks dplyr::nest_join()
## ✖ tidyr::nesting()               masks tidytable::nesting()
## ✖ tidytable::nth()               masks dplyr::nth()
## ✖ tidytable::pick()              masks dplyr::pick()
## ✖ tidyr::pivot_longer()          masks tidytable::pivot_longer()
## ✖ tidyr::pivot_wider()           masks tidytable::pivot_wider()
## ✖ purrr::pmap()                  masks tidytable::pmap()
## ✖ purrr::pmap_chr()              masks tidytable::pmap_chr()
## ✖ purrr::pmap_dbl()              masks tidytable::pmap_dbl()
## ✖ purrr::pmap_df()               masks tidytable::pmap_df()
## ✖ purrr::pmap_dfc()              masks tidytable::pmap_dfc()
## ✖ purrr::pmap_dfr()              masks tidytable::pmap_dfr()
## ✖ purrr::pmap_int()              masks tidytable::pmap_int()
## ✖ purrr::pmap_lgl()              masks tidytable::pmap_lgl()
## ✖ purrr::pmap_vec()              masks tidytable::pmap_vec()
## ✖ tidytable::pull()              masks dplyr::pull()
## ✖ lubridate::quarter()           masks data.table::quarter()
## ✖ tidytable::recode()            masks car::recode(), dplyr::recode()
## ✖ tidytable::reframe()           masks dplyr::reframe()
## ✖ tidytable::relocate()          masks dplyr::relocate()
## ✖ tidytable::rename()            masks dplyr::rename()
## ✖ tidytable::rename_with()       masks dplyr::rename_with()
## ✖ tidyr::replace_na()            masks tidytable::replace_na()
## ✖ tidytable::right_join()        masks dplyr::right_join()
## ✖ tidytable::row_number()        masks dplyr::row_number()
## ✖ tidytable::rowwise()           masks dplyr::rowwise()
## ✖ lubridate::second()            masks data.table::second()
## ✖ MASS::select()                 masks tidytable::select(), dplyr::select()
## ✖ tidytable::semi_join()         masks dplyr::semi_join()
## ✖ tidyr::separate()              masks tidytable::separate()
## ✖ tidyr::separate_longer_delim() masks tidytable::separate_longer_delim()
## ✖ tidyr::separate_rows()         masks tidytable::separate_rows()
## ✖ tidyr::separate_wider_delim()  masks tidytable::separate_wider_delim()
## ✖ tidyr::separate_wider_regex()  masks tidytable::separate_wider_regex()
## ✖ tidytable::slice()             masks dplyr::slice()
## ✖ tidytable::slice_head()        masks dplyr::slice_head()
## ✖ tidytable::slice_max()         masks dplyr::slice_max()
## ✖ tidytable::slice_min()         masks dplyr::slice_min()
## ✖ tidytable::slice_sample()      masks dplyr::slice_sample()
## ✖ tidytable::slice_tail()        masks dplyr::slice_tail()
## ✖ purrr::some()                  masks car::some()
## ✖ Hmisc::src()                   masks dplyr::src()
## ✖ tidytable::summarise()         masks dplyr::summarise()
## ✖ Hmisc::summarize()             masks tidytable::summarize(), dplyr::summarize()
## ✖ tidytable::tally()             masks dplyr::tally()
## ✖ tidytable::top_n()             masks dplyr::top_n()
## ✖ tidytable::transmute()         masks dplyr::transmute()
## ✖ purrr::transpose()             masks data.table::transpose()
## ✖ tidyr::tribble()               masks tibble::tribble(), tidytable::tribble(), dplyr::tribble()
## ✖ tidyr::uncount()               masks tidytable::uncount()
## ✖ tidytable::ungroup()           masks dplyr::ungroup()
## ✖ tidyr::unite()                 masks tidytable::unite()
## ✖ tidyr::unnest()                masks tidytable::unnest()
## ✖ tidyr::unnest_longer()         masks tidytable::unnest_longer()
## ✖ tidyr::unnest_wider()          masks tidytable::unnest_wider()
## ✖ purrr::walk()                  masks tidytable::walk()
## ✖ lubridate::wday()              masks data.table::wday()
## ✖ lubridate::week()              masks data.table::week()
## ✖ purrr::when()                  masks foreach::when()
## ✖ lubridate::yday()              masks data.table::yday()
## ✖ lubridate::year()              masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
metricas <- resultados$values %>%
                         gather(key = "modelo", value = "valor", -Resample) %>%
                         separate(col = "modelo", into = c("modelo", "metrica"),
                                  sep = "~", remove = TRUE)
metricas %>% head(10)
Resample modelo metrica valor
Fold1.Rep1 CART MAE 0.2777558
Fold2.Rep1 CART MAE 0.2676430
Fold3.Rep1 CART MAE 0.2827347
Fold4.Rep1 CART MAE 0.2929360
Fold5.Rep1 CART MAE 0.2964568
Fold1.Rep1 CART RMSE 0.4576083
Fold2.Rep1 CART RMSE 0.3831595
Fold3.Rep1 CART RMSE 0.4667851
Fold4.Rep1 CART RMSE 0.4714483
Fold5.Rep1 CART RMSE 0.5015869

COMPARACIÓN MÉTRICAS

tabla_modelos<-metricas %>% 
  group_by(modelo, metrica) %>% 
  summarise(media = mean(valor)) %>%
  spread(key = metrica, value = media) %>%
  arrange(desc(Rsquared))

kable(tabla_modelos)
modelo MAE RMSE Rsquared
RF 0.2351972 0.3932020 0.6504825
GBM 0.2399222 0.4022086 0.6307544
XGB 0.2520889 0.4121747 0.6097138
SVM 0.2667384 0.4488151 0.5363971
CART 0.2835052 0.4561176 0.5330699
BAG 0.3246993 0.4861056 0.4677843
KNN 0.3196267 0.4937760 0.4471970
RED_NEURONAL 4.7178240 4.7570333 0.3643443
metricas %>%
  filter(metrica == "Rsquared") %>%
  group_by(modelo) %>% 
  summarise(media = mean(valor)) %>%
  ggplot(aes(x = reorder(modelo, media), y = media, label = round(media, 2))) +
    geom_segment(aes(x = reorder(modelo, media), y = 0,
                     xend = modelo, yend = media),
                     color = "grey50") +
    geom_point(size = 7, color = "firebrick") +
    geom_text(color = "white", size = 2.5) +
    scale_y_continuous(limits = c(0, 1)) +
    #Rsquared basal
    geom_hline(yintercept = 0.62, linetype = "dashed") +
    annotate(geom = "text", y = 0.72, x = 8.5, label = "Rsquared") +
    labs(title = "Validación: Rsquared medio repeated-CV",
         subtitle = "Modelos ordenados por media",
         x = "modelo") +
    coord_flip() +
    theme_bw()

VEMOS DE MANERA GRÁFICA LO QUE HEMOS ESTADO REPRESENTANDO EN LAS TABLAS ANTERIORES, Y TAMBIÉN LOS RESULTADOS DE LA APLICACIÓN DE DIFERENTES MODELOS. NOS QUEDAMOS CON LOS DOS MEJORES MODELOS: “RANDOM FOREST” Y “AUMENTO DE GRADIENTE”

TABLA COMPARATIVA ENTRE LOS DOS MEJORES MODELOS

# Aquí mostramos una tabla con lo que describimos arriba:

var_imp_rf=data.frame(varImp(modelo_rf, scale=T)["importance"]) %>%
  dplyr::mutate(variable=rownames(.)) %>% dplyr::rename(importance_rf=Overall) %>%
  dplyr::arrange(-importance_rf) %>%
  dplyr::mutate(rank_rf=seq(1:nrow(.)))

var_imp_gbm=as.data.frame(varImp(modelo_gbm, scale=T)["importance"])  %>%
  dplyr::mutate(variable=rownames(.)) %>% dplyr::rename(importance_gbm=Overall) %>%
  dplyr::arrange(-importance_gbm) %>%
  dplyr::mutate(rank_gbm=seq(1:nrow(.)))                                                                                                                            
final_res=merge(var_imp_rf, var_imp_gbm, by="variable")

final_res$rank_diff=final_res$rank_rf-final_res$rank_gbm


kable(final_res)
variable importance_rf rank_rf importance_gbm rank_gbm rank_diff
ascensor1 4.5035596 7 4.3181893 7 0
buildingStrucuture2 3.4508272 8 4.3118479 8 0
buildingStrucuture3 0.7284224 27 0.1393729 34 -7
buildingStrucuture4 0.5397661 36 0.2007249 25 11
buildingStrucuture5 0.0357842 50 0.0000000 53 -3
buildingStrucuture6 3.0117316 9 1.0379019 14 -5
buildingType2 0.2466139 45 0.2120645 23 22
buildingType3 2.3657130 13 0.6943403 16 -3
buildingType4 2.7232136 11 1.0490650 13 -2
floor10 0.4403207 39 0.0321743 43 -4
floor11 0.6085403 33 0.1422474 32 1
floor12 1.5098768 17 0.4508269 17 0
floor13 0.5431241 35 0.2566470 19 16
floor14 0.4483116 38 0.1073565 37 1
floor15 0.6689872 30 0.2069473 24 6
floor16 1.8381255 15 0.7535442 15 0
floor17 0.5500640 34 0.1694319 28 6
floor18 0.9374118 22 0.1507950 29 -7
floor19 0.4070872 42 0.0330331 42 0
floor2 0.4164141 40 0.0269158 45 -5
floor20 1.9277945 14 2.9833655 9 5
floor21 0.9445132 21 1.2678311 12 9
floor22 1.6108002 16 0.0951833 38 -22
floor23 1.1348313 19 0.2354824 21 -2
floor24 1.1437037 18 0.1413052 33 -15
floor25 0.8247106 25 0.1841988 27 -2
floor26 0.7176827 28 0.1359194 35 -7
floor27 0.6476744 31 0.1469547 31 0
floor28 0.6462636 32 0.2505689 20 12
floor29 0.1920524 46 0.0283250 44 2
floor3 0.5074720 37 0.0857774 39 -2
floor30 0.3727189 43 0.0792108 40 3
floor31 0.1655004 48 0.0519607 41 7
floor32 0.2477272 44 0.0244229 46 -2
floor33 0.0252322 51 0.0000000 48 3
floor34 0.6741037 29 0.0000000 49 -20
floor36 0.0000000 53 0.0000000 50 3
floor37 0.0015916 52 0.0000000 51 1
floor4 0.1717846 47 0.0103447 47 0
floor42 0.1431126 49 0.0000000 52 -3
floor5 0.7324094 26 0.1883520 26 0
floor6 2.5694847 12 2.8984614 10 2
floor7 0.8528066 24 0.2223188 22 2
floor8 0.4104144 41 0.1116364 36 5
floor9 0.9817976 20 0.3784892 18 2
Lat 49.0630434 2 61.8232036 2 0
Lng 42.5547900 3 50.3127812 3 0
metro1 7.0376257 5 4.4084035 6 -1
principales 100.0000000 1 100.0000000 1 0
renovacionCondicion2 0.9027121 23 0.1474637 30 -7
renovacionCondicion3 2.9540355 10 2.1133413 11 -1
renovacionCondicion4 6.0375754 6 4.8813693 5 1
seguidores 23.5154818 4 30.0805975 4 0

EN ESTA TABLA DONDE ESTAMOS COMPARANDO LA IMPORTANCIA DE LAS VARIABLES ENTRE LOS 2 MODELOS MEJORES: RANDOM FOREST Y AUMENTO DE GRADIENTE, VEMOS QUE LAS PRIMERAS VARIABLES SON CASI LAS MISMAS PARA AMBOS: 1.-PRINCIPALES(TAMAÑO Y NÚMERO DE ESTANCIAS) 2.- Y 3.-LATITUD Y LONGITUD(SITUACIÓN GEOGRÁFICA DEL INMUEBLE EN LA CIUDAD) 4.-SEGUIDORES EN LA PÁGINA (5.-QUE HAYA METRO CERCA DEL INMUEBLE PARA RANDOM FOREST, Y QUE TENGA ASCENSOR LA FINCA PARA GBM) 6.-QUE EL PISO TENGA HECHA UNA BUENA REFORMA O NO

load("./traintest_prTotal.RData")


explainerRF<- DALEX::explain(
                                 modelo_rf,
                                 label   = "RANDOM FOREST",
                                 data    = test_prTotal,
                                 y       = test_prTotal$totalPrice1,
                                 verbose = FALSE
                              )
explainerGBM<- DALEX::explain(
                                 modelo_gbm,
                                 label   = "AUMENTOGRADIENTE",
                                 data    = test_prTotal,
                                 y       = test_prTotal$totalPrice1,
                                 verbose = FALSE
                              )
mpRF <- model_performance(explainerRF)
mpGBM <- model_performance(explainerGBM)

plot(mpRF,mpGBM, geom = 'boxplot')

Vemos que los residuos son pequeños y muy parecidos entre ambos modelos.

vi<- model_parts(explainerRF, loss_function = loss_root_mean_square)

plot(vi)

Y aquí podemos ver el error cuadrático medio por variable.

CONCLUSIÓN

INTERPRETABILIDAD DEL MEJOR MODELO “RANDOM FOREST”:

Teniendo en cuenta toda la información anterior, si la prioridad es maximizar la capacidad predictiva del modelo, como primera opción se debería seleccionar el modelo de “random forest”.

El modelo basado en random forest es el que mejores resultados obtiene tanto en el conjunto de test como en la validación (repeated CV). Los modelos basados GBM y XGB consiguen valores de test muy similares.

Vemos que el modelo “RANDOM FOREST” tiene un nivel de R2 medio= 0.65, así que tiene una explicatividad del 65%. No es nada alto nuestro nivel de ajuste y explicatividad del modelo.

Puede haber pasado que en el proceso de construcción del modelo, el hecho de que hayamos sido muy efectivos en la limpieza de outliers, colinealidad, etc. estemos quitando en exceso un cierto grado de ruido necesario en el modelo para evitar un sobreajuste que posteriormente nos puede conducir a un bajo nivel de predicción en el conjunto de test.

maquetar(mod_rf$results %>% arrange(-Rsquared) %>% head(10)) %>% 
  add_header_lines(values = "Resultados entrenamiento del modelo Random Forest ordenados según valor del R2")

Resultados entrenamiento del modelo Random Forest ordenados según valor del R2

mtry

splitrule

min.node.size

RMSE

Rsquared

MAE

RMSESD

RsquaredSD

MAESD

14

variance

5

0.3932020

0.6504825

0.2351972

0.02860972

0.04007672

0.008452444

13

variance

5

0.3948012

0.6484374

0.2370153

0.02798121

0.03938204

0.008192287

12

variance

5

0.3964389

0.6474424

0.2386585

0.02827250

0.04014519

0.008202766

11

variance

5

0.3987860

0.6449262

0.2410152

0.02653840

0.03708779

0.008102723

14

extratrees

5

0.4300250

0.5885064

0.2678760

0.02048415

0.02068966

0.007709120

13

extratrees

5

0.4325538

0.5853444

0.2702101

0.02060142

0.02003163

0.008160807

12

extratrees

5

0.4362643

0.5806498

0.2734250

0.02008255

0.01938413

0.007792220

11

extratrees

5

0.4412765

0.5735376

0.2777879

0.02030082

0.02014833

0.007909555

Alcanza el mejor ajuste con los hiperparámetros: MTRY=14 y MIN.NODO= 5.

IMPORTANCIA DE LAS VARIABLES:

plot(varImp(mod_rf))

LAS VARIABLES MÁS IMPORTANTES SEGÚN EL MODELO SELECCIONADADO COMO EL MEJOR AJUSTE SON: PRINCIPALES (RELACIÓN TAMAÑO Y NÚM. ESTANCIAS), LA UBICACIÓN GEOMÉTRICA DENTRO DE LA CIUDAD DE BEIJING (NO TIENE EL MISMO PRECIO UN PISO EN UN BARRIO QUE EN OTRO) Y EL NÚMERO DE SEGUIDORES DE LA TRANSACCIÓN. SEGUIDO CON DISTANCIA DE LAS VARIABLES METRO Y REFORMA DEL INMUEBLE.

**POR LO TANTO SON LAS VARIABLES MÁS IMPORTANTES QUE TENEMOS QUE TENER EN CUENTA A LA HORA DE SABER EL PRECIO DE UN INMUEBLE EN BEIJING: 1.-TAMAÑO (METROS CUADRADOS DE LA VIVIENDA), NÚMERO DE ESTANCIAS-HABITACIONES-SALONES. 2.-LA POSICIÓN GEOMÉTRICA EN LA CIUDAD. 3.-EL NÚMERO DE SEGUIDORES DE LA TRANSACCIÓN. CUANTO MÁS INTERESADOS HAYA EN EL INMUEBLE, MAYORES OFERTAS RECIBIRÁ EL VENDEDOR. 4.-SERVICIO DE METRO CERCA DEL INMUEBLE. 5.-LA REFORMA GRANDE O INTEGRAL QUE SE LE HAYA HECHO AL INMUEBLE.

NOTAS

La mayor dificultad que he tenido en el examen ha sido la falta de tiempo, para hacer más pruebas y poder hacerlo más completo. Al estar trabajando al mismo tiempo que estudio, esta vez he ido apurada.